Microsoft Word Macro for highlighting multiple words - vba

Question

My intent is to create a very basic macro to find a series of words and highlight them. Unfortunately, I do not know how to do multiple words in one step. For example, the following code works:
Sub Macro1()
'
' Macro1 Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "MJ:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
However, if I add in another .Text = line, then the MJ: is ignored. Any ideas?

Answer 1

If you are only looking for a few words simply doing multiple find and replaces within the same macro will accomplish what you want. For example, the following will highlight in yellow all occurrences of "target1" and "target2"
Sub HighlightTargets()
' --------CODE TO HIGHLIGHT TARGET 1-------------------
Options.DefaultHighlightColorIndex = wdYellow
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "target1"
.Replacement.Text = "target1"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' --------CODE TO HIGHLIGHT TARGET 1-------------------
Options.DefaultHighlightColorIndex = wdYellow
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "target2"
.Replacement.Text = "target2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Alternatively the following code will let you add all the terms to highlight in one line which may be easier to work with.
Sub HighlightTargets2()
Dim range As range
Dim i As Long
Dim TargetList
TargetList = Array("target1", "target2", "target3") ' put list of terms to find here
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdYellow
Loop
End With
Next
End Sub

Answer 2

I had done the following modification. Perhaps not as elegant as the array. But I was thinking along the lines of a user simply pasting a list of values into a field.
Sub HighlightKeyword(SearchWord As String)
'
' HighlightKeyword Macro
'
Options.DefaultHighlightColorIndex = wdYellow
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = SearchWord
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub HighlightKeywordList()
'
' HighlightKeywordList
'
'
Dim HighlightList As String
Dim WordList As Variant
HighlightList = "Lorem Ipsum,amit,Finibus,Bonorum,et Malorum,Vestibulum,Vivamus,Integer"
WordList = Split(HighlightList, ",")
For i = 0 To UBound(WordList)
HighlightKeyword (WordList(i))
Next i
End Sub