Forum Discussion

Copper Contributor

Jun 05, 2021

Solved

highlight exact match text in cells automatically

Is there a way to highlight (in bold ) the part of the text in a range of cells that is exact match with a text in a specific cell? e.g. cellA1 text is SUN and the function to scan all cells whi...

excel

HansVogelaar

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

Sociobright

Copper Contributor

Jun 05, 2021

Thanks Nikolino, I really appreciate your help. If you can help with VGA that will be amazing 🙏

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!