How do I search and highlight multiple terms in Microsoft Word?

Question

My goal is to be able to run this script and have the document search for and highlight a set number of terms, typically 10+ terms. I figured out how to do this with another script I found here, but every time I use it Word crashes.

Below is a simpler version I have pieced together from different forums/videos I found online. It does exactly what I want it to do except I can't figure out how to make it look for more than one term.

The .Text = "Text" works great but only for one term. If I list multiple then it only looks for the one I listed last. I have tested other chunks of code I found online but I can't figure it out.

I am hoping it is a simple fix, especially since the rest of the code does what I want. TIA!

Sub UsingTheFindObject_Medium()

'Declare Variables.
Dim wrdFind As Find
Dim wrdRng As range
Dim wrdDoc As Document

'Grab the ActiveDocument.
Set wrdDoc = Application.ActiveDocument

'Define the Content in the document
Set wrdRng = wrdDoc.Content

'Define the Find Object based on the Range.
Set wrdFind = wrdRng.Find

'Define the parameters of the Search.
With wrdFind
    
'Search the text for the following term(s)
.Text="Test"

.Format = True

.MatchCase = False

.MatchWholeWord = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Do While wrdFind.Execute = True
    
    'Change the color to Yellow.
    wrdRng.HighlightColorIndex = wdYellow
    
Loop

End Sub

Answer 1

Use your current routine as a function.

Here is an example.

Function FindAndMark(sText As String) ' UsingTheFindObject_Medium()
' https://stackoverflow.com/questions/69633517/how-do-i-search-and-highlight-multiple-terms-in-microsoft-word
' Charles Kenyon
'Declare Variables.
    Dim wrdFind As Find
    Dim wrdRng As Range
    Dim wrdDoc As Document

    'Grab the ActiveDocument.
    Set wrdDoc = Application.ActiveDocument

    'Define the Content in the document
    Set wrdRng = wrdDoc.Content

    'Define the Find Object based on the Range.
    Set wrdFind = wrdRng.Find

    'Define the parameters of the Search.
    With wrdFind
        'Search the text for the following term(s)
        .Text = sText
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    '  Mark text
    Do While wrdFind.Execute = True
        'Change the color to Yellow.
        wrdRng.HighlightColorIndex = wdYellow
    Loop
    Set wrdFind = Nothing
    Set wrdRng = Nothing
    Set wrdDoc = Nothing
End Function

Sub MultiFindMark()
    ' https://stackoverflow.com/questions/69633517/how-do-i-search-and-highlight-multiple-terms-in-microsoft-word
    ' Charles Kenyon
    Dim i As Integer
    Const n As Integer = 4  ' set number (n) of terms in search
    Dim sArray(n) As String ' Create array to hold terms
    ' Assign values, starting at 0 and going to n-1
    Let sArray(0) = "Aenean"
    Let sArray(1) = "Pellentesque"
    Let sArray(2) = "libero"
    Let sArray(3) = "pharetra"
    For i = 0 To n - 1
        FindAndMark (sArray(i))
    Next i
    
End Sub

Here is a revision using the code from ASH to handle the Array

Sub MultiFindMark2() 
    ' https://stackoverflow.com/questions/69633517/how-do-i-search-and-highlight-multiple-terms-in-microsoft-word
    ' Charles Kenyon
    ' modified to use methods proposed by ASH
    Dim i As Long
    Dim sArray() As String ' Create array to hold terms
    ' Assign values, starting at 0 and going to n-1
    sArray = Split("Aenean Pellentesque libero pharetra")    ' your list separated by spaces
    For i = 0 To UBound(sArray)
        FindAndMark (sArray(i))
    Next i
    
End Sub

With some of the changes showing as comments:

Sub MultiFindMark2() 
    ' https://stackoverflow.com/questions/69633517/how-do-i-search-and-highlight-multiple-terms-in-microsoft-word
    ' Charles Kenyon
    ' modified to use methods proposed by ASH
    Dim i As Long
'    Const n As Integer = 4  ' set number (n) of terms in search
    Dim sArray() As String ' Create array to hold terms
    ' Assign values, starting at 0 and going to n-1
    sArray = Split("Aenean Pellentesque libero pharetra")    ' your list separated by spaces
'    Let sArray(0) = "Aenean"
'    Let sArray(1) = "Pellentesque"
'    Let sArray(2) = "libero"
'    Let sArray(3) = "pharetra"
    For i = 0 To UBound(sArray)
        FindAndMark (sArray(i))
    Next i
    
End Sub

Note, this still requires the function.

Answer 2

This will do what you want.

Sub HighlightMultipleWords()

Dim sArr() As String
Dim rTmp As Range
Dim x As Long
sArr = Split("highlight specific words") ' your list
Options.DefaultHighlightColorIndex = wdYellow

For x = 0 To UBound(sArr)
Set rTmp = ActiveDocument.Range
    With rTmp.Find
                .Text = sArr(x)
                .Replacement.Text = sArr(x)
                .Replacement.Highlight = True
                .Execute Replace:=wdReplaceAll
    End With
Next

End Sub

Before:

After: