VBA Format manual numbering so auto numbering code can run

Shelley Lou · #31 09-30-2024, 06:50 AM

Hi Greg, I have updated a previous post with before, after and what it should do/end result - it looks like its still the double period issue.

Shelley Lou · #32 09-30-2024, 08:42 AM

Hi Greg, on the whole the code works as it should and I'm really grateful for your time - the only issue is that where there is a period followed by a space (see 1.2 and 1.3.1 in the first image), the code is adding an additional period but is removing the space (see second image).

Before code is run
Manual numbering should be separated by periods and no spaces inbetween.
Before.JPG

After the code has run
Where there is a period followed by a space (see 1.2 and 1.3.1 in first image), the code adds an additional period but does remove the space.
After.JPG

This is what the text should look like when the code has run, no double periods.
What it should look like.jpg

Quote:

Originally Posted by Shelley Lou

Hi Greg, I have updated a previous post with before, after and what it should do/end result - it looks like its still the double period issue.

gmaxey · #33 09-30-2024, 10:32 AM

Shelly, I ran the code I previously updated (posted here again) against your example and it produced the final correct result.

Code:

Option Explicit Private oRngNum As Range Sub FormatManualNumbering() Dim oRng As Range Dim oPar As Paragraph     Application.ScreenUpdating = False     Set oRng = ActiveDocument.Range     oRng.InsertBefore vbCr     With oRng.Find       .ClearFormatting       .Replacement.ClearFormatting       .Forward = True       .Wrap = wdFindStop       .Format = False       .MatchWildcards = False       'Remove spaces starting paras:       .Text = "^p^w"       .Replacement.Text = "^p"       .Execute Replace:=wdReplaceAll     End With     oRng.Characters(1).Delete     For Each oPar In oRng.Paragraphs       If IsNumeric(oPar.Range.Characters(1)) Then         Set oRngNum = oPar.Range         oRngNum.Collapse wdCollapseStart         Do Until oRngNum.Characters.Last.Next Like "[A-Za-z]"           oRngNum.MoveEnd wdCharacter, 1         Loop         ProcessNum       End If     Next    Application.ScreenUpdating = True lbl_Exit:   Exit Sub End Sub Sub ProcessNum() Dim oRng As Range Dim lngIndex As Long Dim bAllNums As Boolean   bAllNums = True   Set oRng = oRngNum.Duplicate   oRng.Collapse wdCollapseEnd   Do Until IsNumeric(oRng.Characters.First.Previous)     oRng.MoveStart wdCharacter, -1   Loop   oRng.Text = "." & vbTab   oRngNum.End = oRng.Start   For lngIndex = 1 To oRngNum.Characters.Count     If Not IsNumeric(oRngNum.Characters(lngIndex)) Then       If oRngNum.Characters(lngIndex) = " " And oRngNum.Characters(lngIndex).Previous = "." Then         oRngNum.Characters(lngIndex).Delete         lngIndex = lngIndex + 1       Else         oRngNum.Characters(lngIndex) = "."         bAllNums = False       End If     End If   Next   If Not bAllNums Then oRngNum.Characters.Last.Next.Delete lbl_Exit:   Exit Sub End Sub

Shelley Lou · #34 10-01-2024, 02:03 AM

Hi Greg, I've run the code you have kindly provided so thank you very much, I really do appreciate the help you always give me.

Only thing I've noticed is that it ignores where there is a digit period space e.g. 1.[space]2 or 1.3.[space]1. I've added arrows to the image to show the spaces. The code does remove the final period which it is supposed to.

Capture.JPG

gmaxey · #35 10-01-2024, 05:22 AM

Shelly, your examples (almost verbatim) is included in the file that I uploaded with my last reply. The previous code worked fine.

The following code is modified to handle one or more spaces in a similar circumstance:

Code:

Option Explicit
Private oRngNum As Range
Sub FormatManualNumbering()
Dim oRng As Range
Dim oPar As Paragraph
    Application.ScreenUpdating = False
    Set oRng = ActiveDocument.Range
    oRng.InsertBefore vbCr
    With oRng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchWildcards = False
      'Remove spaces starting paras:
      .Text = "^p^w"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
    End With
    oRng.Characters(1).Delete
    For Each oPar In oRng.Paragraphs
      If IsNumeric(oPar.Range.Characters(1)) Then
        Set oRngNum = oPar.Range
        oRngNum.Collapse wdCollapseStart
        Do Until oRngNum.Characters.Last.Next Like "[A-Za-z]"
          oRngNum.MoveEnd wdCharacter, 1
        Loop
        ProcessNum
      End If
    Next
   Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub
Sub ProcessNum()
Dim oRng As Range
Dim lngIndex As Long
Dim bAllNums As Boolean
  bAllNums = True
  Set oRng = oRngNum.Duplicate
  oRng.Collapse wdCollapseEnd
  Do Until IsNumeric(oRng.Characters.First.Previous)
    oRng.MoveStart wdCharacter, -1
  Loop
  oRng.Text = "." & vbTab
  oRngNum.End = oRng.Start
  For lngIndex = oRngNum.Characters.Count To 1 Step -1
    If Not IsNumeric(oRngNum.Characters(lngIndex)) Then
      oRngNum.Characters(lngIndex).Select
      If oRngNum.Characters(lngIndex) = " " And oRngNum.Characters(lngIndex).Previous = "." _
         Or oRngNum.Characters(lngIndex).Previous = " " Then
        oRngNum.Characters(lngIndex).Delete
      Else
        oRngNum.Characters(lngIndex) = "."
        bAllNums = False
      End If
    End If
  Next
  If Not bAllNums Then oRngNum.Characters.Last.Next.Delete
lbl_Exit:
  Exit Sub
End Sub

If this is still not working, then please upload and example file.

Shelley Lou · #36 10-01-2024, 05:56 AM

Hi Greg, yes I copied the last code you posted but it was still not removing the space. Is the code working for you in that it removes the space?

In the Test Doc to Run Code, for each manual clause number I've added text to what the code should do for that paragraph and in the After document, I've added text as to what the code has done if that helps. The two highlighted green are the two that haven't updated when the code has run except for removing the end period. I always have my show/hide command activated so I can see all non printing characters within the text.

I'm not sure what else can be done and I fear I've already taken up a lot of your time on this.

Test Doc to run code.docx
After code has run.docx

gmaxey · #37 10-01-2024, 06:19 AM

Shelley,

Yes. It works here. I have attached your "Test Doc to run code.docx" as a .docm file with the code in it. The results you see is after the code was run.

Shelley Lou · #38 10-04-2024, 08:47 AM

Hi Greg, its a bit baffling that it works on your PC but not mine. I've been trying to get the code to work on my PC but to no avail, not even with .docm file, so I've gone back to your original code and have modified it slightly (see red in code) to do what I need it to do and seems to be working so far.

Thanks for all your help on this Greg, it is very much appreciated as always. The code really is awesome.
Best, Shelley

Code:

Private oRngNum As Range
Sub DPU_FormatManualNumbering()
Dim oRng As Range
Dim oPar As Paragraph
    Application.ScreenUpdating = False
    Set oRng = ActiveDocument.Range
    oRng.InsertBefore vbCr
    With oRng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchWildcards = False
      'Remove spaces starting paras:
      .text = "^p^w"
      .Replacement.text = "^p"
      .Execute Replace:=wdReplaceAll
      'Remove empty paras:
        .MatchWildcards = True
        .text = "^13{2,}"
        .Replacement.text = "^p"
        .Execute Replace:=wdReplaceAll
    End With
    oRng.Characters(1).Delete
    For Each oPar In oRng.Paragraphs
      If IsNumeric(oPar.Range.Characters(1)) Then
        Set oRngNum = oPar.Range
        oRngNum.Collapse wdCollapseStart
        Do Until oRngNum.Characters.Last.Next Like "[A-Za-z]"
          oRngNum.MoveEnd wdCharacter, 1
        Loop
        ProcessNum
      End If
    Next
  Set oRng = ActiveDocument.Range
  With oRng.Find
  .MatchWildcards = True
  .text = "([0-9]).."
  .Replacement.text = "\1."
  .Execute Replace:=wdReplaceAll
  End With
   Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub
Sub ProcessNum()
Dim oRng As Range
Dim lngIndex As Long
Dim bAllNums As Boolean
  bAllNums = True
  Set oRng = oRngNum.Duplicate
  oRng.Collapse wdCollapseEnd
  Do Until IsNumeric(oRng.Characters.First.Previous)
    oRng.MoveStart wdCharacter, -1
  Loop
  oRng.text = "." & vbTab
  oRngNum.End = oRng.Start
  For lngIndex = 1 To oRngNum.Characters.count
    If Not IsNumeric(oRngNum.Characters(lngIndex)) Then
      oRngNum.Characters(lngIndex) = "."
      bAllNums = False
    End If
  Next
  If Not bAllNums Then oRngNum.Characters.Last.Next.Delete
lbl_Exit:
  Exit Sub
End Sub

gmaxey · #39 10-04-2024, 01:25 PM

Shelly, can't explain it, but pleased you have something that is working.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA insert period after manual numbering	Shelley Lou	Word VBA	1	03-05-2023 03:45 AM
VBA Remove manual numbering after Outline numbering	Shelley Lou	Word VBA	2	08-04-2021 12:24 AM
VBA converting manual numbering to auto numbering	Shelley Lou	Word VBA	8	05-28-2021 01:08 AM
Applying New Multi-Level List to Existing Document with Manual Numbering and Existing Styles	stanley	Word	4	12-15-2020 10:59 AM
page numbering for manual	Bursal	Word	1	07-29-2018 02:08 PM