Didn't work here. (Word 016). Try this:

Sub HighlightCapitalWordsYellow()
  Dim objRange As Range
 
  With Selection
    With Selection.Find
      .ClearFormatting
      .Text = "[A-Z]{1, }"
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchWildcards = True
      .Execute
    End With
    Do While .Find.Found
      Set objRange = Selection.Range
      objRange.HighlightColorIndex = wdYellow
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
End Sub