Highlight all words in a long text that is in a Cell

Question

I am trying to develop a Find button, to mark in red "ALL" of the word that are contained in a cell.

For example If I have in my cell this text.
"Pepper had peppermint in his pocket"
it should change to this.
"Pepper had peppermint in his pocket"

This code highlights the first word that it finds.

    Dim i As Long
    Dim oldrngrow As Long
    Dim myValue As String
    Dim arr() As Variant
    arr = Array(TextBox1.Value)
    TextBox2.Text = UBound(arr)
    
    For i = 1 To UBound(arr) + 1
        myValue = arr(i - 1)
        If myValue = vbNullString Then
            MsgBox ("Please Enter a Word in Textbox")
            End
        End If
        
        Set rng = Cells.Find(What:=myValue, After:=Cells(1, i), LookIn:= _
            xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
            xlNext, MatchCase:=False, MatchByte:=True, SearchFormat:=False)
            
            If rng Is Nothing Then
                GoTo skip
            End If
            
            oldrngrow = rng.Row
            Do While rng.Column = i
                If ComboBox1.Text = "Red" Then
                    rng.Characters(InStr(rng, myValue), Len(myValue)).Font.ColorIndex = 3
                    Set rng = Cells.FindNext(After:=rng)
                    
                If oldrngrow = rng.Row Then
            Exit Do
                End If
            Loop
    skip:
    Next i

Admin · Answer

Interesting question. After some research, I’ve put together the following code to demonstrate how to highlight every instance of a word in a string within a cell. For the sake of the demonstration, it uses an Input Box to get the desired string-to-highlight (you can change the method), and assumes the range to search is simply A1 – again you can change this to whatever you want.

Make sure you include Option Compare Text at the top of the Sub – otherwise the search will be case sensitive. Let me know how you go.

Option Compare Text
Sub StringColor()

Dim myRange As Range, myCell As Range, myString As String, myCount As Integer
Set myRange = Range("A1")

myString = InputBox("Type the word you want to color in A1")

For Each myCell In myRange
    For myCount = 1 To Len(myCell) - Len(myString) + 1
        If Mid(myCell, myCount, Len(myString)) = myString Then
            myCell.Characters(myCount, Len(myString)).Font.Color = vbRed
        End If
    Next myCount
Next myCell

End Sub

Highlight all words in a long text that is in a Cell

1 Answers