Sub FlagAlpaNumericWords()
Dim oRng As Range, oNum As Range
Dim bCompound As Boolean
Dim lngStart As Long
  Set oRng = ActiveDocument.Range
  With oRng.Find
    Do While .Execute(findText:="[0-9]{1,}", MatchWildcards:=True)
      bCompound = False
      Set oNum = oRng.Words(1)
      lngStart = oNum.Start
      Do While oRng.Characters.First.Previous = "-"
        oRng.MoveStart wdCharacter, -1
        oRng.MoveStart wdWord, -1
        oNum.Start = oRng.Start
        bCompound = True
      Loop
      Do While oRng.Characters.Last.Next = "-"
        oRng.MoveEnd wdCharacter, 1
        oRng.MoveEnd wdWord, 1
        bCompound = True
      Loop
      If bCompound Then
        Set oNum = oRng
        If oNum.Start > lngStart Then oNum.Start = lngStart
        oNum.Select
      Else
        oNum.End = oNum.End - 1
      End If
      If TestRegExp("[A-Z]", oNum.Text) = True Then
        oNum.HighlightColorIndex = wdYellow
      End If
      oRng.Collapse 0
    Loop
  End With
End Sub

Function TestRegExp(strFind As String, strText As String) As Boolean
Dim objRegExp As Object
  Set objRegExp = CreateObject("VBScript.RegExp")
  objRegExp.Pattern = strFind
  objRegExp.IgnoreCase = True
  objRegExp.Global = True
  TestRegExp = objRegExp.Test(strText)
  Set objRegExp = Nothing
End Function

Sub HilitePartNumsHyph()
  Dim rngWord As Range, aRng As Range, sWord As String
  Dim oRng As Range, oNum As Range, rngFrag As Range, sPref As String
  
  Set oRng = ActiveDocument.Range
  With oRng.Find
    Do While .Execute(findText:="[0-9]{1,}", MatchWildcards:=True)
      Set oNum = oRng.Words(1)
      sWord = UCase(Trim(oNum.Text))
      If sWord Like "*[A-Z]*" Then                  'If there is a letter included it is a part num
        sPref = Ucase(oNum.Characters.First.Previous)
        Do While SwitchHitter(sPref)     'Look back
          oNum.MoveStart Unit:=wdWord, Count:=-1
        Loop
        If oNum.Text = Trim(oNum.Text) Then   'not ending with a space
          Do While SwitchHitter(UCase(oNum.Characters.Last.Next))   'Look forward
            oNum.MoveEnd Unit:=wdWord, Count:=1
          Loop
        End If
        oNum.HighlightColorIndex = wdYellow
        Debug.Print oNum                            'This is the output list
      End If
      oRng.Start = oNum.End
    Loop
  End With
End Sub

Function SwitchHitter(aChar As String, Optional str As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-") As Boolean
  'Returns true if the character appears in provided string
  SwitchHitter = InStr(str, aChar) > 0
End Function