I also found this code on the Web.
I also have a macro for highlighting lists of Words which could be adapted
to your own requirements. Replace the words in the vFindText arrays with
your own words. You can continue the theme with other colours and words as
required.
Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long
'highlight red words
Options.DefaultHighlightColorIndex = wdRed
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
vFindText = Array("anger", "violence", "fighting")
vReplText = "^&"
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = False
For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText
.Replacement.Highlight = True
.Execute replace:=wdReplaceAll
Next i
End With
'Highlight blue words
Options.DefaultHighlightColorIndex = wdBlue
vFindText = Array("depression", "misery")
vReplText = "^&"
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText
.Replacement.Highlight = True
.Execute replace:=wdReplaceAll
Next i
End With
End Sub
|