Sub CompoundCRs()
Dim strTerms As String
Dim arrTerms() As String
Dim lngIndex As Long, lngOffset As Long
Dim bCompound As Boolean
Dim oRng As Range
  Application.ScreenUpdating = False
  strTerms = "[Aa]rticle,[Aa]ppendix,[Cc]lause,[Pp]aragraph,[Pp]art,[Ss]chedule" 'highlight numbers after these words
  arrTerms = Split(strTerms, ",")
  On Error GoTo Err_Handler
  For lngIndex = 0 To UBound(arrTerms)
    Set oRng = ActiveDocument.Range
    'Set oRng = oRng.Duplicate
    With oRng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Text = arrTerms(lngIndex) & "[s ^s]@[0-9.]{1,}" 'Highlight manual cross refs
      Do While .Execute
        oRng.MoveStart wdWord, 1
        oRng.HighlightColorIndex = wdBrightGreen
        oRng.Collapse wdCollapseEnd
        bCompound = True
        Do While bCompound
          Select Case True
            Case oRng.Characters.Last.Text = "-"
              oRng.Move wdCharacter, 1
              lngOffset = 0
            Case oRng.Characters.Last.Text = "," And oRng.Characters.Last.Next.Text = " "
               oRng.Move wdCharacter, 2
               lngOffset = 0
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "-" And oRng.Characters.Last.Next.Next.Text = " "
              oRng.Move wdCharacter, 3
              lngOffset = 3
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "t" And oRng.Characters.Last.Next.Next.Text = "o" And oRng.Characters.Last.Next.Next.Next.Text = " "
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "o" And oRng.Characters.Last.Next.Next.Text = "r" And oRng.Characters.Last.Next.Next.Next.Text = " "
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "a" And oRng.Characters.Last.Next.Next.Text = "n" And oRng.Characters.Last.Next.Next.Next.Text = "d" And oRng.Characters.Last.Next.Next.Next.Text = "d"
              oRng.Move wdCharacter, 5
              lngOffset = 5
            Case 2 = 1 'I'll let you work out hte and/or syntax
            Case Else
              bCompound = False
          End Select
          If bCompound Then
            oRng.MoveEnd wdCharacter, 1
            Do While IsNumeric(oRng.Characters.Last.Next) Or (oRng.Characters.Last.Next = "." And IsNumeric(oRng.Characters.Last.Next.Next))
              oRng.MoveEnd wdCharacter, 1
            Loop
            If IsNumeric(oRng.Characters.First.Text) Then oRng.HighlightColorIndex = wdBrightGreen
            oRng.Collapse wdCollapseEnd
            If lngOffset > 0 Then
              oRng.Move wdCharacter, -lngOffset
            End If
          End If
        Loop
      Loop
     End With
Next_For:

  Next
  Application.ScreenUpdating = True
  MsgBox "Complete"
  Selection.HomeKey Unit:=wdStory
lbl_Exit:
  Exit Sub
Err_Handler:
   MsgBox Err.Number & " - " & Err.Description
  Resume Next_For

 End Sub