Shelly,
After some more thought, I think setting a range from the end of a found CR number to the end of the storyrange and then using InStr is easier to code and perhaps more efficient (also no errors):
Code:
Sub Test()
Application.ScreenUpdating = False
CompoundCRs2 ActiveDocument.Range
CompoundCRs2 ActiveDocument.StoryRanges(wdFootnotesStory)
Application.ScreenUpdating = True
Selection.HomeKey Unit:=wdStory
MsgBox "Complete"
End Sub
Sub CompoundCRs2(oRngPassed As Range)
Dim strTerms As String
Dim arrTerms() As String
Dim lngIndex As Long, lngOffset As Long
Dim bCompound As Boolean
Dim oRng As Range, oRngEval As Range
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
Set oRng = oRngPassed.Duplicate
'The reason the one instance with the non-breaking space was missed is because you had a non-breaking and normal space (2 spaces)
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Text = "[ ^s]{2,}"
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
End With
For lngIndex = 0 To UBound(arrTerms)
Set oRng = oRngPassed.Duplicate
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Text = arrTerms(lngIndex) & "[s ^s]@[0-9.]{1,}"
Do While .Execute
oRng.MoveStart wdWord, 1
oRng.HighlightColorIndex = wdBrightGreen
oRng.Collapse wdCollapseEnd
bCompound = True
Do While bCompound
Set oRngEval = oRngPassed.Duplicate
oRngEval.Start = oRng.End
Select Case True
Case InStr(oRngEval, "-") = 1
oRng.Move wdCharacter, 1
lngOffset = 0
Case InStr(oRngEval, ", ") = 1
oRng.Move wdCharacter, 2
lngOffset = 0
Case InStr(oRngEval, " - ") = 1
oRng.Move wdCharacter, 3
lngOffset = 3
Case InStr(oRngEval, " or ") = 1
oRng.Move wdCharacter, 4
lngOffset = 4
Case InStr(oRngEval, " to ") = 1
oRng.Move wdCharacter, 4
lngOffset = 4
Case InStr(oRngEval, " and ") = 1
oRng.Move wdCharacter, 5
lngOffset = 5
Case InStr(oRngEval, " and/or ") = 1
oRng.Move wdCharacter, 8
lngOffset = 8
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
lbl_Exit:
Exit Sub
Err_Handler:
MsgBox Err.Number & " - " & Err.Description
Resume Next_For
End Sub