Sub Demo()
Application.ScreenUpdating = False
Dim strTxt As String, i As Long
strTxt = "|"
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[A-Z]{2} [0-9]{4,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If InStr(strTxt, "|" & .Text & "|") = 0 Then
      strTxt = strTxt & .Text & "|"
    Else
      i = i + 1
      .HighlightColorIndex = wdYellow
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " duplicates found."
End Sub