SOLVED

highlight exact match text in cells automatically

Copper Contributor

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 which will contain SUN within and make it bold.
e.g.  CellB2 text: i love SUNshine

9 Replies

@Sociobright 

That's with VBA programming. Perhaps someone could help if you consider such option.

@Sociobright 

As Mr. Baklan has already informed you, VBA would be the best solution for this.

Should look and send later...if time :).

Until then, here are some alternative approaches using formulas.

 

Thank you for your understanding and patience

 

Nikolino

I know I don't know anything (Socrates)

Thanks Nikolino, I really appreciate your help. If you can help with VGA that will be amazing :folded_hands:
best response confirmed by Sociobright (Copper Contributor)
Solution

@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 

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.

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?

@Sociobright 

Highlighting all duplicate words in cells? That would be a daunting task!

@Hans Vogelaar After I run it, how I can cancel the bold and then start a new searching?

@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
1 best response

Accepted Solutions
best response confirmed by Sociobright (Copper Contributor)
Solution

@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

View solution in original post