Option Explicit

Sub FindAbbr()
Const sAbbrDoc As String = "C:\Path\Abbreviations.docx"    'the path of the abbreviations table document
Dim oDoc As Document, oAbbr As Document
Dim oTable As Table
Dim oRng As Range
Dim i As Long
    If MsgBox("This could take some time!", vbOKCancel + vbInformation) = vbCancel Then
        MsgBox "User cancelled", vbInformation
        GoTo lbl_Exit
    End If
    Set oDoc = ActiveDocument
    Set oAbbr = Documents.Open(sAbbrDoc)
    Set oTable = oAbbr.Tables(1)
    For i = 1 To oTable.Rows.Count
        Set oRng = oTable.Cell(i, 1).Range
        oRng.End = oRng.End - 1
        Find_Replace oDoc, oRng.Text, "^&", False, True, True
        DoEvents
    Next i
    oAbbr.Close 0
    MsgBox "Search complete", vbInformation
lbl_Exit:
    Set oDoc = Nothing
    Set oAbbr = Nothing
    Set oTable = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Private Sub Find_Replace(ByRef oDoc As Word.Document, _
                         ByRef strFind As String, _
                         ByRef strReplace As String, _
                         Optional ByRef bMatchWC As Boolean, _
                         Optional ByRef bMatchCase As Boolean, _
                         Optional ByRef bFWWO As Boolean)
Dim rngStory As Word.Range
Dim oShp As Shape

    For Each rngStory In oDoc.StoryRanges
        Select Case rngStory.StoryType
            Case 1 To 11
                Do
                    SrcAndRplInStory rngStory, strFind, strReplace, _
                                     bMatchWC, bMatchCase, bFWWO
                    On Error Resume Next
                    DoEvents

                    On Error GoTo 0
                    Select Case rngStory.StoryType
                        Case 6, 7, 8, 9, 10, 11
                            If rngStory.ShapeRange.Count > 0 Then
                                For Each oShp In rngStory.ShapeRange
                                    If oShp.TextFrame.HasText Then
                                        SrcAndRplInStory oShp.TextFrame.TextRange, _
                                                         strFind, strReplace, _
                                                         bMatchWC, bMatchCase, bFWWO
                                    End If
                                    DoEvents
                                Next oShp
                            End If
                        Case Else
                            'Do Nothing
                    End Select
                    On Error GoTo 0
                    'Get next linked story (if any)
                    Set rngStory = rngStory.NextStoryRange
                Loop Until rngStory Is Nothing
            Case Else
        End Select
        DoEvents
    Next rngStory
lbl_Exit:
    Set rngStory = Nothing
    Exit Sub
err_Handler:
    Resume lbl_Exit
End Sub

Private Sub SrcAndRplInStory(ByVal rngStory As Word.Range, _
                             ByVal strSearch As String, _
                             ByVal strReplace As String, _
                             ByVal bMatchWildCards As Boolean, _
                             ByVal bMatchCase As Boolean, _
                             ByVal bFindWWO As Boolean)


    With rngStory.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = strSearch
        .Replacement.Text = strReplace
        .Replacement.Highlight = True
        .MatchWildcards = bMatchWildCards
        .MatchCase = bMatchCase
        .MatchWholeWord = bFindWWO
        .Execute Replace:=wdReplaceAll
    End With
lbl_Exit:
    Exit Sub
End Sub

Sub Macro2()
Const sAbbrDoc As String = "C:\Path\Abbreviations.docx"    'the path of the abbreviations table document
Dim oDoc As Document, oAbbr As Document
Dim oRng As Range
Dim i As Long
    Options.DefaultHighlightColorIndex = wdYellow
    Set oDoc = ActiveDocument
    Set oAbbr = Documents.Open(sAbbrDoc)
    Set oRng = oDoc.Range
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = True
        .MatchWildcards = False
        Do While .Execute
            SrcAndRplInStory oAbbr.Tables(1).Range, oRng.Text, "^&", False, False, False
            oRng.Collapse 0
        Loop
    End With
lbl_Exit:
    Set oDoc = Nothing
    Set oAbbr = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Sub CheckAcroInUse()
  Dim aTbl As Table, sAbb As String, aRng As Range, aCell As Cell
  Set aTbl = ActiveDocument.Tables(ActiveDocument.Tables.Count)
  Set aRng = ActiveDocument.Range(0, aTbl.Range.Start)
  
  For Each aCell In aTbl.Columns(1).Cells
    sAbb = Split(aCell.Range.Text, vbCr)(0)
    If InStr(aRng.Text, sAbb) = 0 Then
      aCell.Range.HighlightColorIndex = wdYellow
    End If
  Next aCell
End Sub

https://wordribbon.tips.net/T001173_Highlight_Words_from_a_Word_List.html

Sub CompareWordList()
    Dim sCheckDoc As String
    Dim docRef As Document
    Dim docCurrent As Document
    Dim wrdRef As Object

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

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

    For Each wrdRef In docRef.Words
        If Asc(Left(wrdRef, 1)) > 32 Then
            With Selection.Find
                .Wrap = wdFindContinue
                .Text = wrdRef
                .Execute Replace:=wdReplaceAll
            End With
        End If
    Next wrdRef

    docRef.Close
    docCurrent.Activate
End Sub

https://stackoverflow.com/questions/49292384/highlight-words-microsoft-word-from-checklist-and-highlight-matching-words-in-c