Sub ComparePhraseList()
Dim sCheckDoc As String
Dim docRef As Document
Dim docCurrent As Document
Dim i As Integer
Dim oPara As Range


sCheckDoc = "c:\path\checkphrases.docx"  'Change to the path where the document is located.
   Set docCurrent = Selection.Document
    Set docRef = Documents.Open(sCheckDoc)
    docCurrent.Activate
    Options.DefaultHighlightColorIndex = wdYellow

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

    For i = 1 To docRef.Paragraphs.Count
        Set oPara = docRef.Paragraphs(i).Range
        oPara.End = oPara.End - 1
        With Selection.Find
            .Wrap = wdFindContinue
            .Text = oPara.Text
            .Execute Replace:=wdReplaceAll
        End With
    Next i

    docRef.Close
    docCurrent.Activate
    Set docRef = Nothing
    Set docCurrent = Nothing
    Set oPara = Nothing
   
End Sub