Microsoft Office Forums - View Single Post - [Solved] VBA help to update a highlight macro

Shelley Lou · 10-31-2021, 07:11 AM

Hi Guys, I posted a few days ago but posting again in the hope someone can help me and I don't have to cross post. I know I have received a lot of help from you guys in the past and I'm either just terrible at learning code or its just not sinking in. I know what I want it to do, I just can't seem to execute it well at all. I've literally gone through code I have in other macros to see if I can pick bits to add to this one and I have spent all weekend literally reading hundreds of posts but everything I try just isn't working. Am I on the right track with the partial codes below (I know they are incorrect), I'm trying to not use the global .Text = "[0-9]" that highlights every single digit in my document and limit what it does highlight. What do I need to add to implement this into the code I previously posted. It would be really helpful if comments were added so I can see the logic of what each step is doing so I can better understand the code and stop bothering you all so much. Much appreciate.

This Code

Code:

Dim strFnd As String, i As Long, Rng As Range, ArrFnd1, ArrFnd2, ArrFnd3, ArrWords1, ArrWords2

'NOT TO HIGHLIGHT IF DIGITS BEFORE OR AFTER THESE WORDS/DATES
'ArrFnd1 = ArrFnd = Array("[Mm]inute", "[Hh]our", "[Dd]ay", "[Ww]eek", "[Mm]onth", "[Yy]ear", "[Ww]orking", "[Bb]usiness", "Act", "section", "Rule", "Regulation, "Order")
'ArrFnd2 = Array ("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")

'TO ONLY HIGHLIGHT DIGITS AFTER THESE WORDS
'ArrFnd3 = Array("[Cc]lause", "[Pp]aragraph", "[Pp]art", "[Ss]chedule", "[Aa]ppendix", "[Aa]nnexure")

          Options.DefaultHighlightColorIndex = wdTurquoise
          .MatchCase = False
         .MatchWildcards = True
         For i = 0 To UBound(ArrFnd3)
         .Text = "(" & ArrFnd3(i) & "[ ^s][0-9.]{1,})" 'highlights if digits also have periods between them
         .Execute Replace:=wdReplaceAll
         .Text = ArrFnd3(i) & "s" & "[ ^s][0-9.]{1,}" 'and its plural
         .Execute Replace:=wdReplaceAll
         
         'Need to include if brackets follow e.g. clause 1.1(a)
         'Need to include digits if after 'to' and 'and' e.g. clauses 1 to 10
         
        Next

Or this Code

Code:

.Text = "(" & ArrFnd3(i) & "[ ^s][0-9]{1,})"
    .MatchWildcards = True
    .MatchCase = False
    .MatchWholeWord = True
    While .Execute
      Select Case oRng.Start
        Case 0
          oRng.HighlightColorIndex = wdTurquoise
        Case 1
          If Not oRng.Characters.First.Previous.Text Like "ArrFnd1" Then
            oRng.HighlightColorIndex = wdNoHighlight
          End If
        Case Else
      End Select
    Wend

'FIND CASE AND HIGHLIGHT

Code:

ArrWords1 = Array("this Lease", "this Agreement", "this Deed", "this Contract")
ArrWords2 = Array("this lease", "this agreement", "this deed", "this contract")
For i = 0 To UBound(ArrWords1)
Set oRng = ActiveDocument.Range
  With oRng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "ArrWords1(i)" 'Can this be found in the document - if yes - search doc for instances of lowercase not bold and highlight yellow e.g. this lease
  .Font.Bold = True     'If no - change search to look for lowercase bold (ArrWords2) and highlight instances of e.g. this Lease
  .MatchCase = True
  While .Execute
  'Now find any instances of lowercase not formatted bold
  If oRng.Characters.Last.Text = wdLowerCase Then
  oRng.Characters.Last.Font.Bold = False
  oRng.HighlightColorIndex = wdYellow
  'or if ArrFnd2 is lowercase search for last word title case
End If
    Wend