Here are two simplified approaches you might try. The first highlights only those numbers that stand alone (e.g. Clause 23, but not Clause 2.2), whereas the second highlights both. Note the wildcard expressions used to capture both cases and plurals.
Code:
Sub DemoA()
Application.ScreenUpdating = False
Dim StrFndA As String, i As Long, Rng As Range
StrFndA = "[Cc]lause,[Pp]aragraph,[Pp]art,[Ss]chedule" 'highlight numbers after these words
For Each Rng In ActiveDocument.StoryRanges
With Rng
Select Case .StoryType
Case wdMainTextStory, wdFootnotesStory
For i = 0 To UBound(Split(StrFndA, ","))
With .Duplicate
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Text = Split(StrFndA, ",")(i) & "[s ]@[0-9]@>[. ][!0-9]"
End With
Do While .Find.Execute
.Start = .Words(2).Start
.End = .Words.First.End
.HighlightColorIndex = wdBrightGreen
.Collapse wdCollapseEnd
Loop
End With
Next
Case Else
End Select
End With
Next Rng
Application.ScreenUpdating = True
End Sub
Code:
Sub DemoB()
Application.ScreenUpdating = False
Dim StrFndA As String, i As Long, Rng As Range
StrFndA = "[Cc]lause,[Pp]aragraph,[Pp]art,[Ss]chedule" 'highlight numbers after these words
StrFndB = "minute,hour,day,week,month,year,working,business" 'highlight numbers before these words
For Each Rng In ActiveDocument.StoryRanges
With Rng
Select Case .StoryType
Case wdMainTextStory, wdFootnotesStory
For i = 0 To UBound(Split(StrFndA, ","))
With .Duplicate
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Text = Split(StrFndA, ",")(i) & "[s ]@[0-9.]{1,}"
End With
Do While .Find.Execute
.Start = .Words(2).Start
.HighlightColorIndex = wdYellow
.Collapse wdCollapseEnd
Loop
End With
Next
Case Else
End Select
End With
Next Rng
Application.ScreenUpdating = True
End Sub