.Start = .Words(2).Start

Sub DemoB()
Application.ScreenUpdating = False
Dim StrFndA As String, StrFndB As String, i As Long, Rng As Range
StrFndA = "[Cc]lause,[Pp]aragraph,[Pp]art,[Ss]chedule" 'highlight numbers after these words
StrFndB = "[Mm]inute,[Hh]our,[Dd]ay,[Ww]eek,[Mm]onth,[Yy]ear,[Ww]orking,[Bb]usiness" '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 \^s]@[0-9.]{1,}"
            End With
            Do While .Find.Execute
              .Start = .Words(2).Start
              .HighlightColorIndex = wdTurquoise
              .Collapse wdCollapseEnd
            Loop
          End With
        Next
      Case Else
    End Select
  End With
Next Rng
Application.ScreenUpdating = True
End Sub