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

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