Sub ScratchMacro()
Dim Prefixes As Variant, Prefix As Variant
Dim oColUnique As New Collection
Dim arrUnique() As String
Dim lngIndex As Long
Dim oRng As Range
Dim strOut As String
  'What do we want to find
  Prefixes = Array("PE-", "JEB-", "HEL-")
  For Each Prefix In Prefixes
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = Prefix & "[0-9]{1,}"
      .Forward = True
      While .Execute
        On Error Resume Next
        oColUnique.Add Trim(oRng.Text), Trim(oRng.Text)
        If Err.Number = 0 Then
          'Any duplicate will error (i.e., and error number <> 0). This code runs for unique results only.
          ReDim Preserve arrUnique(lngIndex)
          arrUnique(lngIndex) = oRng.Text
          lngIndex = lngIndex + 1
        End If
        oRng.Collapse wdCollapseEnd
      Wend
    End With
  Next Prefix
  'Sort results
  WordBasic.SortArray arrUnique
  'Form a string from the results
  strOut = Join(arrUnique, vbCr) & vbCr & "Total - " & UBound(arrUnique) + 1
  'Msgbox strOut
  WriteToTextFile "D:\Collection Results.txt", strOut
lbl_Exit:
  Exit Sub
End Sub

Sub WriteToTextFile(strPath As String, strContent As String)
Dim oFSO As Object, oFile As Object
Dim lngIndex As Long
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oFile = oFSO.CreateTextFile(strPath)
  oFile.Close
  lngIndex = FreeFile
  Open strPath For Output As #lngIndex
  Print #lngIndex, strContent
  Close #lngIndex
lbl_Exit:
  Set oFSO = Nothing: Set oFile = Nothing
  Exit Sub
End Sub