Sub HighlightTermsBody()
    'Updated 2021-05-26
    '
    'This macro highlights all identical appearances of the selected text (formatting and capitalization), minus trailing and leading spaces
    'Only whole words are highlighted 
    'This macro uses the macro ClearFindAndReplaceParameters and this must be installed for it to run properly
    '
    'Written by Michael Schuler (https://bergerplusschuler.com)

    Dim bTrackRevFlag As Boolean
    Dim sSel As String
    Const sDialogTitle As String = "Highlight Terms"
    Const iHighlightColor As Integer = wdGray50
    
    bTrackRevFlag = ActiveDocument.TrackRevisions
    
    On Error GoTo Err_Msg
    
    'If Selection.Type = wdSelectionIP Then
    '    MsgBox "No selection has been made.", vbExclamation, sDialogTitle
    '    GoTo Macroend
    'End If
    
    If Selection.Type = wdSelectionIP Then Selection.Expand wdWord

    ActiveDocument.TrackRevisions = False
    sSel = Selection.Text
    sSel = Trim(sSel)
    Options.DefaultHighlightColorIndex = iHighlightColor

    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Highlight = True
        .Text = sSel
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = True
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Call ClearFindAndReplaceParameters

Macroend:
    ActiveDocument.TrackRevisions = bTrackRevFlag
    Exit Sub
    
Err_Msg:
    ActiveDocument.TrackRevisions = bTrackRevFlag
    MsgBox "The macro has encountered an error." & vbCrLf & Err.Number & ": " & Err.description, vbCritical, sDialogTitle
    
End Sub

Private Sub ClearFindAndReplaceParameters()

    'from https://wordmvp.com/FAQs/MacrosVBA/ClearFind.htm
    'can be run from any search to reset the search parameters

    With Selection.Find
       .ClearFormatting
       .Replacement.ClearFormatting
       .Text = ""
       .Replacement.Text = ""
       .Forward = True
       .Wrap = wdFindStop
       .Format = False
       .MatchCase = False
       .MatchWholeWord = False
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
    End With

End Sub