View Single Post
 
Old 07-03-2024, 04:38 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 include Character Code 002D Dash-Minus

Hi Vivka, thank you for the explanation of the character codes which is really helpful. Unfortunately that line of code doesn't work within my full code but it has given me something to work on so thank you (full code below).

Code:
Sub CompoundCRs(oRngPassed As Range)
Dim strTerms As String
Dim arrTerms() As String
Dim lngIndex As Long, lngOffset As Long
Dim bCompound As Boolean
Dim oRng As Range, oRngEval As Range

  strTerms = "[Aa]rticle,[Aa]ppendix,[Cc]lause,[Pp]aragraph,[Pp]art,[Ss]chedule" 'highlight numbers after these words
  arrTerms = Split(strTerms, ",")
  On Error GoTo Err_Handler
  Set oRng = oRngPassed.Duplicate
  
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .text = "[^s]"
    .Replacement.text = " "
    .Execute Replace:=wdReplaceAll
  End With
  For lngIndex = 0 To UBound(arrTerms)
    Set oRng = oRngPassed.Duplicate
    With oRng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
      .text = arrTerms(lngIndex) & "[s ^s]@[0-9.]{1,}" 'looks for singular and plural of string words
      Do While .Execute
        oRng.MoveStart wdWord, 1
        oRng.HighlightColorIndex = wdBrightGreen
        oRng.Collapse wdCollapseEnd
        bCompound = True
        Do While bCompound
          Set oRngEval = oRngPassed.Duplicate
          oRngEval.Start = oRng.End
          Select Case True
            Case InStr(oRngEval, "-") = 1 'highlights if cross refs seperated by a dash e.g. clause 1-2
              oRng.Move wdCharacter, 1
              lngOffset = 0
            Case InStr(oRngEval, ", ") = 1 'highlights if cross refs seperated by a comma e.g. clause 1, 2
               oRng.Move wdCharacter, 2
               lngOffset = 0
            Case InStr(oRngEval, " - ") = 1 'highlights if cross refs seperated by a dash and space either side e.g. clause 1 - 2 THIS CURRENTLY DOESN'T WORK
              oRng.Move wdCharacter, 3
              lngOffset = 3
            Case InStr(oRngEval, " or ") = 1 'highlights if cross refs seperated by the word 'or' e.g. clause 1 or 2
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case InStr(oRngEval, " to ") = 1 'highlights if cross refs seperated by the word 'to' e.g. clause 1 to 2
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case InStr(oRngEval, " and ") = 1 'highlights if cross refs seperated by the word 'and' e.g. clause 1 and 2
              oRng.Move wdCharacter, 5
              lngOffset = 5
            Case InStr(oRngEval, " and/or ") = 1 'highlights if cross refs seperated by the word 'and/or' e.g. clause 1 and/or 2
              oRng.Move wdCharacter, 8
              lngOffset = 8
            Case Else
              bCompound = False
          End Select
          If bCompound Then
            oRng.MoveEnd wdCharacter, 1
            Do While IsNumeric(oRng.Characters.Last.Next) Or (oRng.Characters.Last.Next = "." And IsNumeric(oRng.Characters.Last.Next.Next))
              oRng.MoveEnd wdCharacter, 1
            Loop
            If IsNumeric(oRng.Characters.First.text) Then oRng.HighlightColorIndex = wdBrightGreen
            oRng.Collapse wdCollapseEnd
            If lngOffset > 0 Then
              oRng.Move wdCharacter, -lngOffset
            End If
          End If
        Loop
      Loop
     End With
Next_For:
  Next
lbl_Exit:
  Exit Sub
Err_Handler:
  MsgBox Err.Number & " - " & Err.Description
  Resume Next_For
End Sub
Reply With Quote