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

Sociobright

Copper Contributor

Jun 05, 2021

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

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?

Forum Discussion

highlight exact match text in cells automatically

Resources