![]()
Sub HighLight() Dim WS As Worksheet, c As Range Dim FindWord() As String Dim MyStart As Long, MyLength As Long ReDim FindWord(1 To 946) FindWord(1) = "feel" 'change to your preference FindWord(2) = "felt" FindWord(3) = "think " FindWord(4) = "thought" FindWord(5) = "ador" FindWord(6) = "afraid" FindWord(7) = "alright" FindWord(8) = "amazed" FindWord(9) = "anger" FindWord(10) = "appreciate" FindWord(11) = "argued" FindWord(12) = "awarded" FindWord(13) = "awkward" FindWord(14) = "bad" **up to 946** For Each WS In Worksheets For i = 1 To 946 With WS.Cells Set c = .Find(FindWord(i), LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do MyStart = InStr(UCase(c.Value), UCase(FindWord(i))) MyLength = Len(FindWord(i)) With c.Characters(Start:=MyStart, Length:=MyLength).Font .Size = 13 .Color = -16776961 End With 'c.Interior.ColorIndex = 35 'now green, change to your preference Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If End With Next Next End Sub
Bookmarks