Find specific words in a worksheet and change the font color of those words

[dbowlds]

Hello, I'm pretty new to Excel VBA. I have spent a few hours Googling for this answer but everything I find and try doesn't work for me. I have a 3 column Excel spreadsheet. I need to search for a specific word, such as "test" in column 2 ("B") within the worksheet and, if found, select that word and change its font color. I cannot figure out how to do this. Can someone please help?

Note, the spreadsheet, when created, will have a random number of rows, but the 3 columns will be fixed, and the search column will always be the 2nd column. I actually have three different words I want to search for. They are: "test," "exam," and "quiz."
Each I would want colored differently (test=vbRed, exam=vbBlue, quiz=vbGreen).

Any help would be MOST appreciated.
Doug

[sassora]

Hi Doug

I've edited some code available on extendoffice.com ~ https://www.extendoffice.com/documen...ain-words.html (no affiliation).

Hope this helps.

Sub HighlightStrings()'Changes font color of words found in selected cells


    Dim xHStr As String, xStrTmp As String
    Dim xHStrLen As Long, xCount As Long, I As Long
    Dim xCell As Range
    Dim xArr
    Dim WordsLookup(1 To 3, 1 To 2) As Variant
    Dim WordNum As Long
    
    On Error Resume Next
    Application.ScreenUpdating = False
    
    WordsLookup(1, 1) = "test"
    WordsLookup(1, 2) = vbRed
    WordsLookup(2, 1) = "exam"
    WordsLookup(2, 2) = vbBlue
    WordsLookup(3, 1) = "quiz"
    WordsLookup(3, 2) = vbGreen
    
    For WordNum = 1 To 3
        xHStr = WordsLookup(WordNum, 1)
        xHStrLen = Len(xHStr)
        For Each xCell In Selection 'This can be set to a particular range
            xArr = Split(xCell.Value, xHStr)
            xCount = UBound(xArr)
            If xCount > 0 Then
                xStrTmp = ""
                For I = 0 To xCount - 1
                    xStrTmp = xStrTmp & xArr(I)
                    xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.Color = WordsLookup(WordNum, 2)
                    xStrTmp = xStrTmp & xHStr
                Next I
            End If
        Next xCell
    Next WordNum
    Application.ScreenUpdating = True
End Sub

[mana]

Option Explicit

Sub test()
    Dim v(1 To 3, 1 To 2)
    Dim k As Long, c As Range, m As Object
    
    v(1, 1) = "test": v(1, 2) = vbRed
    v(2, 1) = "exam": v(2, 2) = vbBlue
    v(3, 1) = "quiz": v(3, 2) = vbGreen
    
    Application.ScreenUpdating = False
    
    With CreateObject("VBScript.RegExp")
        .Global = True
        For k = LBound(v) To UBound(v)
            For Each c In Cells(1).CurrentRegion.Columns(2).Cells
                .Pattern = v(k, 1)
                If .test(c.Value) Then
                    For Each m In .Execute(c.Value)
                        c.Characters(m.firstindex + 1, m.Length).Font.Color = v(k, 2)
                    Next
                End If
            Next
        Next
    End With

End Sub

[dbowlds]

Sassora and Mana,
Thank you both for the very quick responses.
I tried each of your suggestions and in both instances I receive a Method or Data Member not Found error when I compile. The error occurs whenever there is a code line that tries to obtain the cell.value (it doesn't like the .value).
I am wondering if the problem has to do with the fact that I am running this from within Word not Excel (perhaps I should have mentioned this? Sorry!). I have a subroutine in Word that creates a spreadsheet and fills the 3 columns. The 2nd column is the one that would have the multiple instances of 3 words for which I am trying to find and change the font color.
Does this situation explain why the .value is erroring out on me?

[mana]

Option Explicit

Sub test2()
  Dim ws As Object
  Dim v(1 To 3, 1 To 2)
  Dim k As Long, c As Object, m As Object
   
  Set ws = GetObject(, "Excel.Application").activesheet

  v(1, 1) = "test": v(1, 2) = vbRed
  v(2, 1) = "exam": v(2, 2) = vbBlue
  v(3, 1) = "quiz": v(3, 2) = vbGreen

  Application.ScreenUpdating = False

  With CreateObject("VBScript.RegExp")
    .Global = True
    For k = LBound(v) To UBound(v)
      For Each c In ws.Cells(1).CurrentRegion.Columns(2).Cells
        .Pattern = v(k, 1)
        If .test(c.Value) Then
    
          For Each m In .Execute(c.Value)
            c.Characters(m.firstindex + 1, m.Length).Font.Color = v(k, 2)
          Next
        End If
      Next
    Next
  End With

End Sub

[dbowlds]

Mana! That worked perfectly! Thank you so very much!
I can see that I have a lot to learn about VBA in Excel!
I will mark this as solved.
Doug