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/documents/excel/4826-excel-color-certain-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