Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
    Do While .Execute(FindText:="\(insert * emoji\)", MatchWildcards:=True, Forward:=True, Wrap:=wdFindStop) = True
        With Selection
            If MsgBox("Click OK to colorize selection", vbOKCancel) = vbOK Then
                .Range.Shading.BackgroundPatternColor = wdColorYellow
            End If
            .Collapse wdCollapseEnd
        End With
    Loop
End With