Sub MatchHighlight()
'Graham Mayor - https://www.gmayor.com - Last updated - 08 Oct 2024
Dim oDoc As Document
Dim oRng As Range
Dim oCol As Collection
Dim i As Integer

    Set oDoc = ActiveDocument
    Set oRng = oDoc.Range
    Set oCol = New Collection
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = True
        Do While .Execute = True
            oCol.Add oRng.Text & "/" & oRng.HighlightColorIndex, _
                     oRng.Text & "/" & oRng.HighlightColorIndex
            oRng.Collapse 0
        Loop
    End With
    For i = 1 To oCol.Count
        Set oRng = oDoc.Range
        With oRng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = Split(oCol(i), "/")(0)
            Do While .Execute = True
                oRng.HighlightColorIndex = Split(oCol(i), "/")(1)
                oRng.Collapse 0
            Loop
        End With
    Next i
lbl_Exit:
    Set oDoc = Nothing
    Set oRng = Nothing
    Set oCol = Nothing
    Exit Sub
End Sub