Sub HighlightUnhighlightedInstancesOfHighlightedWords()
    Dim doc As Document
    Dim rng As Range
    Dim findText As String
    Dim highlightColor As Long
    Dim tempRng As Range
    Dim startPos As Long

    Set doc = ActiveDocument

    ' Loop through each word in the document
    For Each rng In doc.Words
        If rng.HighlightColorIndex <> wdNoHighlight Then
            ' Store the highlighted word and its highlight color
            findText = Trim(rng.Text)
            highlightColor = rng.HighlightColorIndex

            ' Find all instances of the highlighted word
            Set tempRng = doc.Content
            With tempRng.Find
                .ClearFormatting
                .Text = findText
                .Format = True
                .MatchWholeWord = True
                .MatchCase = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Forward = True
                .Wrap = wdFindStop

                Do While .Execute
                    ' Check if the found instance is not already highlighted
                    If tempRng.HighlightColorIndex = wdNoHighlight Then
                        tempRng.HighlightColorIndex = highlightColor
                    End If
                    ' Move the range past the found instance
                    startPos = tempRng.End
                    tempRng.Collapse wdCollapseEnd
                    tempRng.Start = startPos
                    tempRng.End = doc.Content.End
                Loop
            End With
        End If
    Next rng
End Sub