Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #16  
Old 03-18-2024, 01:22 PM
gmaxey gmaxey is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Shelley, Your requirement is pretty complex and I've spent about all the free time on it as I have to spare. Take a look at this:



Code:
Sub CompoundCRs()
Dim strTerms As String
Dim arrTerms() As String
Dim lngIndex As Long, lngOffset As Long
Dim bCompound As Boolean
Dim oRng As Range
  Application.ScreenUpdating = False
  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
  For lngIndex = 0 To UBound(arrTerms)
    Set oRng = ActiveDocument.Range
    'Set oRng = oRng.Duplicate
    With oRng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Text = arrTerms(lngIndex) & "[s ^s]@[0-9.]{1,}" 'Highlight manual cross refs
      Do While .Execute
        oRng.MoveStart wdWord, 1
        oRng.HighlightColorIndex = wdBrightGreen
        oRng.Collapse wdCollapseEnd
        bCompound = True
        Do While bCompound
          Select Case True
            Case oRng.Characters.Last.Text = "-"
              oRng.Move wdCharacter, 1
              lngOffset = 0
            Case oRng.Characters.Last.Text = "," And oRng.Characters.Last.Next.Text = " "
               oRng.Move wdCharacter, 2
               lngOffset = 0
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "-" And oRng.Characters.Last.Next.Next.Text = " "
              oRng.Move wdCharacter, 3
              lngOffset = 3
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "t" And oRng.Characters.Last.Next.Next.Text = "o" And oRng.Characters.Last.Next.Next.Next.Text = " "
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "o" And oRng.Characters.Last.Next.Next.Text = "r" And oRng.Characters.Last.Next.Next.Next.Text = " "
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "a" And oRng.Characters.Last.Next.Next.Text = "n" And oRng.Characters.Last.Next.Next.Next.Text = "d" And oRng.Characters.Last.Next.Next.Next.Text = "d"
              oRng.Move wdCharacter, 5
              lngOffset = 5
            Case 2 = 1 'I'll let you work out hte and/or syntax
            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
  Application.ScreenUpdating = True
  MsgBox "Complete"
  Selection.HomeKey Unit:=wdStory
lbl_Exit:
  Exit Sub
Err_Handler:
   MsgBox Err.Number & " - " & Err.Description
  Resume Next_For

 End Sub
I'll leave it to you to work out the and/or part and discover why one of your examples is not hightlighted.
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #17  
Old 03-19-2024, 01:26 AM
Shelley Lou Shelley Lou is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2016
Competent Performer
VBA IF Statement Help
 
Join Date: Dec 2020
Posts: 170
Shelley Lou is on a distinguished road
Default VBA IF Statement Help

Hi Greg, quite simply WOW, this is simply amazing, thank you so much for spending the time on creating this, it would take me a lifetime to come up with something like this, really can't thank you enough.

I can see its those pesky non breaking spaces causing trouble again, I will have to test further with ^s, although strangely it works ok for 'and'.

Just so I can understand the code a bit better, the 'and' part of the code below seems to have two "d" ranges and I wondered why that was.

Code:
 Case oRng.Characters.Last.text = " " And oRng.Characters.Last.Next.text = "a" And oRng.Characters.Last.Next.Next.text = "n" And oRng.Characters.Last.Next.Next.Next.text = "d" And oRng.Characters.Last.Next.Next.Next.text = "d"
oRng.Move wdCharacter, 5 'Seperated by the word 'and'
              lngOffset = 5
Am I on the right track with this line of code for the 'and/or' - its not working yet but if you say I'm on the right track I have something to work with.

Code:
Case oRng.Characters.Last.text = " " And oRng.Characters.Last.Next.text = "a" And oRng.Characters.Last.Next.Next.text = "n" And oRng.Characters.Last.Next.Next.Next.text = "d" And oRng.Characters.Last.Next.Next.Next.Next.text = "/" _
And oRng.Characters.Last.Next.Next.Next.Next.Next.text = "o" And oRng.Characters.Last.Next.Next.Next.Next.Next.Next.text = "r" And oRng.Characters.Last.Next.Next.Next.Next.Next.Next.Next.text = " "
oRng.Move wdCharacter, 8
lngOffset = 8
Reply With Quote
  #18  
Old 03-19-2024, 06:41 AM
gmaxey gmaxey is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Shelley,


The double "d" was a typo. Rather than repeating the fourth validator, the fifth validator should have been:
oRng.Characters.Last.Next.Next.Next.Next.Text = " "


Yes, you were very close. So close in fact that I copied your code into the procedure and it worked fine.

Now, when you run the revised code in the attached document you are going to get an error message. I will leave it to you to figure out why and how you want to handle it.

Also, the next suggestion it to break your main procedure up into meaningful chunks. You have already got a process for highlighting your manual CRs. Rather than burying it is a tangle of other code, break it out into a separate procedure. This can make troubleshooting and managing your project easier. E.g.,


Code:
Sub MainProcedure()
  Application.ScreenUpdating = False
  'Do things
  'Do things
  'Call the CompoundCR procedure for the main text then footnotes
  CompoundCRs ActiveDocument.Range
  CompoundCRs ActiveDocument.StoryRanges(wdFootnotesStory)
  'Do things or call other procedures
  Application.ScreenUpdating = True
  Selection.HomeKey Unit:=wdStory
  MsgBox "Complete"
lbl_Exit:
  Exit Sub
End Sub

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
  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
  'The reason the one instance with the non-breaking space was missed is because you had a non-breaking and normal space (2 spaces)
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Text = "[ ^s]{2,}"
    .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,}"
      Do While .Execute
        oRng.Select
        oRng.MoveStart wdWord, 1
        oRng.HighlightColorIndex = wdBrightGreen
        oRng.Collapse wdCollapseEnd
        bCompound = True
        Do While bCompound
          Select Case True
            Case oRng.Characters.Last.Text = "-"
              oRng.Move wdCharacter, 1
              lngOffset = 0
            Case oRng.Characters.Last.Text = "," And oRng.Characters.Last.Next.Text = " "
               oRng.Move wdCharacter, 2
               lngOffset = 0
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "-" And oRng.Characters.Last.Next.Next.Text = " "
              oRng.Move wdCharacter, 3
              lngOffset = 3
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "t" And oRng.Characters.Last.Next.Next.Text = "o" And oRng.Characters.Last.Next.Next.Next.Text = " "
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "o" And oRng.Characters.Last.Next.Next.Text = "r" And oRng.Characters.Last.Next.Next.Next.Text = " "
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "a" And oRng.Characters.Last.Next.Next.Text = "n" And oRng.Characters.Last.Next.Next.Next.Text = "d" And oRng.Characters.Last.Next.Next.Next.Next.Text = " "
              oRng.Move wdCharacter, 5
              lngOffset = 5
            Case oRng.Characters.Last.Text = " " And oRng.Characters.Last.Next.Text = "a" And oRng.Characters.Last.Next.Next.Text = "n" And oRng.Characters.Last.Next.Next.Next.Text = "d" And oRng.Characters.Last.Next.Next.Next.Next.Text = "/" _
                 And oRng.Characters.Last.Next.Next.Next.Next.Next.Text = "o" And oRng.Characters.Last.Next.Next.Next.Next.Next.Next.Text = "r" And oRng.Characters.Last.Next.Next.Next.Next.Next.Next.Next.Text = " "
              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
Attached Files
File Type: docm Highlight clause references.docm (35.6 KB, 0 views)
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #19  
Old 03-19-2024, 06:58 AM
gmaxey gmaxey is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Shelly,


After some more thought, I think setting a range from the end of a found CR number to the end of the storyrange and then using InStr is easier to code and perhaps more efficient (also no errors):


Code:
Sub Test()
  Application.ScreenUpdating = False
  CompoundCRs2 ActiveDocument.Range
  CompoundCRs2 ActiveDocument.StoryRanges(wdFootnotesStory)
  Application.ScreenUpdating = True
  Selection.HomeKey Unit:=wdStory
  MsgBox "Complete"
End Sub
Sub CompoundCRs2(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
  'The reason the one instance with the non-breaking space was missed is because you had a non-breaking and normal space (2 spaces)
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Text = "[ ^s]{2,}"
    .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,}"
      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
              oRng.Move wdCharacter, 1
              lngOffset = 0
            Case InStr(oRngEval, ", ") = 1
               oRng.Move wdCharacter, 2
               lngOffset = 0
            Case InStr(oRngEval, " - ") = 1
              oRng.Move wdCharacter, 3
              lngOffset = 3
            Case InStr(oRngEval, " or ") = 1
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case InStr(oRngEval, " to ") = 1
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case InStr(oRngEval, " and ") = 1
              oRng.Move wdCharacter, 5
              lngOffset = 5
            Case InStr(oRngEval, " and/or ") = 1
              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
Attached Files
File Type: docm Highlight clause references.docm (37.0 KB, 2 views)
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/

Last edited by gmaxey; 03-19-2024 at 11:21 PM.
Reply With Quote
  #20  
Old 03-19-2024, 08:27 AM
Shelley Lou Shelley Lou is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2016
Competent Performer
VBA IF Statement Help
 
Join Date: Dec 2020
Posts: 170
Shelley Lou is on a distinguished road
Default VBA IF Statement Help

Greg, wow, this code is something else, thank you so much.

Aaaah yes, I am getting an error 5941 member does not exist on this line of code, so I will look into why this is happening:

Code:
CompoundCRs2 ActiveDocument.StoryRanges(wdFootnotesStory)
I've just seen the comment in the code about the non-breaking space and space together before the manual cross ref, I think that could have just been my dodgy typing when I was putting the small document together for you. I will look into updating the code to include if there is a non-breaking space between the string words and manual cross refs.

That is a very good idea to break the code up into sections as the original highlight code was getting a bit out of control and very hard to see where I was going wrong so I will definitely split that up into smaller chunks.

A massive thank you Greg for helping me.
Reply With Quote
  #21  
Old 03-19-2024, 01:20 PM
gmaxey gmaxey is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Shelly,


With the revised code, you should not be getting an error with the sample text you provided.


Code:
Option Explicit
Sub MainProcedure()
  Application.ScreenUpdating = False
  'Do things
  'Do things
  'Call the CompoundCR procedure for the main text then footnotes
  CompoundCRs ActiveDocument.Range
  CompoundCRs ActiveDocument.StoryRanges(wdFootnotesStory)
  'Do things or call other procedures
  Application.ScreenUpdating = True
  Selection.HomeKey Unit:=wdStory
  MsgBox "Complete"
lbl_Exit:
  Exit Sub
End Sub
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
  'The reason the one instance with the non-breaking space was missed is because you had a non-breaking and normal space (2 spaces)
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Text = "[ ^s]{2,}"
    .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,}"
      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
              oRng.Move wdCharacter, 1
              lngOffset = 0
            Case InStr(oRngEval, ", ") = 1
               oRng.Move wdCharacter, 2
               lngOffset = 0
            Case InStr(oRngEval, " - ") = 1
              oRng.Move wdCharacter, 3
              lngOffset = 3
            Case InStr(oRngEval, " or ") = 1
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case InStr(oRngEval, " to ") = 1
              oRng.Move wdCharacter, 4
              lngOffset = 4
            Case InStr(oRngEval, " and ") = 1
              oRng.Move wdCharacter, 5
              lngOffset = 5
            Case InStr(oRngEval, " and/or ") = 1
              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
Attached Files
File Type: docm Highlight clause references.docm (34.5 KB, 4 views)
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #22  
Old 03-20-2024, 01:09 AM
Shelley Lou Shelley Lou is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2016
Competent Performer
VBA IF Statement Help
 
Join Date: Dec 2020
Posts: 170
Shelley Lou is on a distinguished road
Default VBA IF Statement Help

Hi Greg, I've tested the code and yes it works if there are footnotes present in the document but doesn't work if there are no footnotes, its looking for a footnote but if not there its creating the error. Would something like this work do you think?

Code:
For Each oRng In ActiveDocument.StoryRanges
With oRng
Select Case .StoryType
Case wdMainTextStory, wdFootnotesStory
I have also done as you suggested and split the other code into 3 sections and added as Calls to the Sub MainProcedure.
Reply With Quote
  #23  
Old 03-20-2024, 01:18 AM
gmaxey gmaxey is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Shelley,


Ah, yes. I see what you mean. Yes, changing the main procedure to something like this will work:

Code:
Sub MainProcedure()
Dim oRng As Range
  Application.ScreenUpdating = False
  'Do things
  'Do things
  'Call the CompoundCR procedure for the main text and footnotes (if exists)
  For Each oRng In ActiveDocument.StoryRanges
    Select Case oRng.StoryType
      Case 1, 2: CompoundCRs oRng
    End Select
  Next oRng
  'Do things or call other procedures
  Application.ScreenUpdating = True
  Selection.HomeKey Unit:=wdStory
  MsgBox "Complete"
lbl_Exit:
  Exit Sub
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #24  
Old 03-20-2024, 01:19 PM
Shelley Lou Shelley Lou is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2016
Competent Performer
VBA IF Statement Help
 
Join Date: Dec 2020
Posts: 170
Shelley Lou is on a distinguished road
Default VBA IF Statement Help

Hi Greg, yes that has definitely worked, thank you so much. Thank you for suggesting I split the previous code into a few sections so I can identify any errors easily. I've run each section individually to see how they perform before updating the MainProcedure code with the various Calls and for some reason, the CompoundCRs code is changing spaces after periods at the end of sentences from two spaces to one space (our housestyle is two spaces). I can't see why this is happening though.

I've been trying to update the CompoundCRs code to include if there is a space or non-breaking space present but nothing has worked yet so I remembered what you said in an earlier post that sometimes its best to remove something and put it back in at the end, so I've added a find and replace in the CompoundCRs Code to remove any non-breaking spaces associated with the cross references and created a new Call to reinstate the non-breaking spaces at the end of the process.

I can't thank you enough for your help on this, it will really help me a lot when housestyling documents going forward.

Code:
Sub DPU_ReinstateNonBreakingSpaces_CRs()
Dim oRng As Range, fld As Field, sFind1 As String, arr() As String, i As Long
sFind1 = "[Aa]rticle [Aa]rticles [Aa]ppendix [Aa]ppendices [Cc]lause [Cc]lauses [Pp]aragraph [Pp]aragraphs [Pp]art [Pp]arts [Ss]chedule [Ss]chedules [Ss]ection [Ss]ections Act [Rr]egulation [Rr]egulations [Oo]rder [Rr]ule [Rr]rules"
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
arr = Split(sFind1, " ")
    For i = 0 To UBound(arr)
   .text = "(" & arr(i) & ") ([0-9.]{1,})"     'NBS for clause etc. references in the array
   .Replacement.text = "\1^s\2"
   .Execute Replace:=wdReplaceAll
    Next
    For Each fld In oRng.Fields                     'Spaces before auto cross-refs are NBS
            If fld.Type = wdFieldRef Then
                If Not fld.Result.Previous Is Nothing Then
                    Set oRng = fld.Result.Previous.Characters(1)
                    If oRng.text = Chr(32) Then oRng.text = Chr(160)
                End If
            End If
  Next
  End With
End Sub
Reply With Quote
  #25  
Old 03-20-2024, 03:06 PM
gmaxey gmaxey is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Shelley,


The reason for the replacement is code that I added to the CompoundCR procedure to replace 2 or more spaces with a singe space. That fixed that one issue where the CR number wasn't being picked up. You can take that out if you wish.
Code:
With oRng.Find 
  .ClearFormatting 
  .Replacement.ClearFormatting 
  .Forward = True 
  .Wrap = wdFindStop
  .MatchWildcards = True
   .Text = "[ ^s]{2,}"
   .Replacement.Text = " "
   .Execute  Replace:=wdReplaceAll
End With
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #26  
Old 04-01-2024, 10:48 AM
TessaMurillo TessaMurillo is offline VBA IF Statement Help Windows Vista VBA IF Statement Help Office 2010
Advanced Beginner
 
Join Date: Mar 2024
Posts: 33
TessaMurillo has a little shameless behaviour in the past
Default

Hello and thank you for your question. To capture cases where more than one bold punctuation occurs together, you can use additional checks inside the IF statement.
Reply With Quote
  #27  
Old 04-02-2024, 05:55 AM
Shelley Lou Shelley Lou is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2016
Competent Performer
VBA IF Statement Help
 
Join Date: Dec 2020
Posts: 170
Shelley Lou is on a distinguished road
Default VBA IF Statement Help

Hi Greg, its been a while since I last responded to you as I've been on annual leave but just wanted to say thank you so much for all the help you have given me for this code, I've come back from annual leave today and started working with the code - it really has come such a long way from where this all started 2 years ago, I really can't thank you enough. Best wishes.

Tessa, thank you for your response also, although not quite sure what you mean by additional checks inside the IF Statement.
Reply With Quote
  #28  
Old 04-02-2024, 06:08 AM
gmaxey gmaxey is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Shelley,


You are welcome. You can ignore Tessa. He or she is posting in multiple treads (many already answered and marked solved) with useless drive by responses that add little or nothing to the post.
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #29  
Old 04-02-2024, 08:37 AM
Shelley Lou Shelley Lou is offline VBA IF Statement Help Windows 10 VBA IF Statement Help Office 2016
Competent Performer
VBA IF Statement Help
 
Join Date: Dec 2020
Posts: 170
Shelley Lou is on a distinguished road
Default VBA IF Statement Help

Thanks Greg, yes I did wonder what the post was about as I think we have covered everything already so it was definitely a pointless post. I will now mark this as solved - it has been an absolute joy to work on my housestyle documents today with this code. Best wishes.
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
VBA IF Statement Help IF Statement (again) teza2k06 Excel 8 02-11-2022 08:41 AM
Converting a Select statement in Excel to an update statement shabbaranks Excel Programming 5 10-31-2018 11:47 PM
VBA IF Statement Help Need a little help with an if statement cangelis Excel 2 04-08-2015 05:55 PM
VBA IF Statement Help If statement, may be? Tony Singh Excel 6 03-04-2015 12:52 PM
VBA IF Statement Help Need help with If, Then Statement Please cangelis Excel 4 01-03-2014 09:10 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 11:21 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft