View Single Post
 
Old 08-08-2022, 08:58 AM
Shelley Lou Shelley Lou is offline Windows 10 Office 2016
Expert
 
Join Date: Dec 2020
Posts: 259
Shelley Lou is on a distinguished road
Default VBA Highlight numbers only after or before specific words help

Hi Macropod, I have added the second process to the code and that is working fine when there are no cross reference fields but even after adding the other two lines of code it is still bugging with error 5941 if there are cross reference fields - I have added a test document so you can see what is happening.

Code:
.Start = .Words(2).Start
Highlight numbers after or before.docx

Code:
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
Reply With Quote