highlight exact match text in cells automatically

Sub MakeTextBold() Dim TextToFind As String Dim Cell As Range Dim CellAddress As String Dim Pos As Long Application.ScreenUpdating = False TextToFind = Range("A1").Value With Cells ' Change MatchCase:=False to MatchCase:=True if the search should be case-sensitive Set Cell = .Find(What:=TextToFind, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) If Not Cell Is Nothing Then CellAddress = Cell.Address Do Pos = InStr(1, Cell.Value, TextToFind, vbTextCompare) Do While Pos Cell.Characters(Start:=Pos, Length:=Len(TextToFind)).Font.Bold = True Pos = InStr(Pos + 1, Cell.Value, TextToFind, vbTextCompare) Loop Set Cell = .FindNext(After:=Cell) If Cell Is Nothing Then Exit Do Loop Until Cell.Address = CellAddress End If End With Application.ScreenUpdating = True End Sub

NikolinoDE
Gold Contributor
Jun 05, 2021
Sociobright
Here is another example with VBA.
Press the Text Merge button and everything should appear as you want.

Thank you for your understanding and patience

I would be happy to know if I could help.

Nikolino
I know I don't know anything (Socrates)

As a member of this community, I provide my help for self-help without guarantee.
Please Mark and Vote this reply if it helps, as it will be beneficial to more Community members reading here.
TEXT_Funktion_SUNnshine-1.xlsm18 KB

HansVogelaar

MVP

Jun 05, 2021

Sociobright

Here is a macro:

Sub MakeTextBold()
    Dim TextToFind As String
    Dim Cell As Range
    Dim CellAddress As String
    Dim Pos As Long
    Application.ScreenUpdating = False
    TextToFind = Range("A1").Value
    With Cells
        ' Change MatchCase:=False to MatchCase:=True if the search should be case-sensitive
        Set Cell = .Find(What:=TextToFind, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
        If Not Cell Is Nothing Then
            CellAddress = Cell.Address
            Do
                Pos = InStr(1, Cell.Value, TextToFind, vbTextCompare)
                Do While Pos
                    Cell.Characters(Start:=Pos, Length:=Len(TextToFind)).Font.Bold = True
                    Pos = InStr(Pos + 1, Cell.Value, TextToFind, vbTextCompare)
                Loop
                Set Cell = .FindNext(After:=Cell)
                If Cell Is Nothing Then Exit Do
            Loop Until Cell.Address = CellAddress
        End If
    End With
    Application.ScreenUpdating = True
End Sub

wuihnag
Copper Contributor
Apr 23, 2022
HansVogelaar After I run it, how I can cancel the bold and then start a new searching?
- HansVogelaar
  MVP
  Apr 23, 2022
  wuihnag
  
  Select the entire range (or press Ctrl+A), then click Bold on the Home tab of the ribbon (or press Ctrl+B). Depending on the selection, you may have to click Bold / press Ctrl+B one more time.
  
  If you prefer a macro:
  
  Sub RemoveBold() Cells.Font.Bold = False End Sub
Sociobright
Copper Contributor
Jun 11, 2021
Thank you Hans, very appreciated! Since I am a noob and just now I started learning about macros, how do I modify this macro to have it running/scanning across all the cells within a worksheet and highlighting the duplicate text keywords?
- HansVogelaar
  MVP
  Jun 11, 2021
  Sociobright
  
  Highlighting all duplicate words in cells? That would be a daunting task!

Forum Discussion

highlight exact match text in cells automatically

Resources