Sub Demo()
Dim oRng As Word.Range
Dim i As Long, j As Long
Dim bFound As Boolean
  Application.ScreenUpdating = False
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "<[A-Z][! ]@>"
    .Wrap = wdFindStop
    .MatchWildcards = True
    While .Execute
      bFound = True
      oRng.MoveEnd wdWord, 6
      For i = 2 To oRng.Words.Count
        If Not oRng.Words(i).Characters(1) Like "[A-Z]" Then bFound = False
      Next
      If bFound = True Then
        j = j + 1
        MsgBox oRng.Text
      End If
      oRng.Collapse wdCollapseEnd
    Wend
  End With
  Application.ScreenUpdating = True
  MsgBox j & " instances found."
End Sub