Macro (Find & Replace) for MS Word

I’ve created a Macro (below) for MS Word that finds / replaces (with highlights) key “red flag” terms in contractual documents. It cross-references a master “checklist” (checklist.doc) against the open document and highlights key terms that may need additional review by the appropriate SME.

However, the “MatchWholeWord” function isn’t correctly working with the “checklist” document. For example:
•      The word “lease” is being found in words such as “please” or “release” with only the “lease” portion of the word being highlighted.
•      The word “SLA” is being found in words such as “legislate” with only the “sla” porting being highlighted.
•      The word “govern” is being found in words such as such as “government” with only the “govern” portion of the word being highlighted.

I’m somewhat knowledgeable about macros but it’s been at least 10 years since I was proficient.

Any idea what might be causing the problem?

Thank you for any guidance!

---------------------------------

Sub RedFlags()
    Dim sCheckDoc As String
    Dim docRef As Document
    Dim docCurrent As Document
    Dim wrdRef As String
    Dim wrdPara As Paragraph

    sCheckDoc = "c:\checklist.doc"
    Set docCurrent = Selection.Document
    Set docRef = Documents.Open(sCheckDoc)
    docCurrent.Activate

    Options.DefaultHighlightColorIndex = wdRed
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True

    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Highlight = True
        .Replacement.Text = "^&"
        .Forward = True
        .Format = True
        .MatchWholeWord = True
        .MatchCase = False
        .MatchWildcards = False
    End With

    For Each wrdPara In docRef.Paragraphs
    wrdRef = wrdPara.Range.Text
        If Asc(Left(wrdRef, 1)) > 32 Then
        ' remove the paragraph mark:
        wrdRef = Left(wrdRef, Len(wrdRef) - 1)

            With Selection.Find
                .Wrap = wdFindContinue
                .Text = wrdRef
                .Execute Replace:=wdReplaceAll
            End With
        End If
    Next wrdPara

docRef.Close
docCurrent.Activate
End Sub

Select allOpen in new window

Edit by GrahamSkan: Code put into a code snippet box.