Shelly,
With the revised code, you should not be getting an error with the sample text you provided.
Code:
Option Explicit
Sub MainProcedure()
Application.ScreenUpdating = False
'Do things
'Do things
'Call the CompoundCR procedure for the main text then footnotes
CompoundCRs ActiveDocument.Range
CompoundCRs ActiveDocument.StoryRanges(wdFootnotesStory)
'Do things or call other procedures
Application.ScreenUpdating = True
Selection.HomeKey Unit:=wdStory
MsgBox "Complete"
lbl_Exit:
Exit Sub
End Sub
Sub CompoundCRs(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