.Start = .Words(2).Start

Sub DemoB()
Application.ScreenUpdating = False
ActiveWindow.ActivePane.View.ShowFieldCodes = True
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
        For i = 0 To UBound(Split(StrFndB, ","))
          With .Duplicate
            With .Find
              .ClearFormatting
              .Replacement.ClearFormatting
              .Forward = True
              .Wrap = wdFindStop
              .MatchWildcards = True
              .text = "[0-9]{1,}[ \^s]" & Split(StrFndB, ",")(i)
            End With
            Do While .Find.Execute
              .End = .Words(.Words.Count).Start - 1
              .HighlightColorIndex = wdTurquoise
              .Collapse wdCollapseEnd
            Loop
          End With
        Next
      Case Else
    End Select
  End With
Next Rng
ActiveWindow.ActivePane.View.ShowFieldCodes = False
Application.ScreenUpdating = True
End Sub