VBA Format manual numbering so auto numbering code can run

vivka · #1 08-06-2024, 08:41 AM

Hi, Shelley Lou! You can change your code to

Code:

.text = "^13[!^13]@[^t ]"

But this may bring about new problems because spaces are everywhere in the text including between numbers in multi-level lists (e.g.: 2 2.2tabfolllowing a written...). As a remedy, I would replace all digit-letter spaces with tabs and then run the original code. Or, please, post a new (more complex, including as many numbering cases as possible) sample of your doc to try different code changes on.

Shelley Lou · #2 08-06-2024, 08:48 AM

Hi Vivka, yes I did try that variation but it didn't work for me. I've attached an updated test document so you can see what I mean with regard to the spaces - not sure how to get around this.

format manual numbering before running auto numbering code.docx

vivka · #3 08-06-2024, 10:49 AM

Hi again, Shelley Lou! I think we did it at last! The code has bloated but it works properly in (as I think) all possible cases (see the attached test doc modified by me).

Code:

Sub FormatManualNumbering()
'In active doc, format multi-level manual numbering.

Dim rng As range
Dim rngEnd As Long

Application.ScreenUpdating = False
    Set rng = ActiveDocument.range
    rngEnd = rng.End
    rng.Characters.First.InsertBefore Chr(13)
    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        .text = "(^13[!^13]@)([A-Za-z])"
        .Replacement.text = "\1^t\2"
        .Execute Replace:=wdReplaceAll
        .text = "^t^t"
        .Replacement.text = "^t"
        .Execute Replace:=wdReplaceAll
    End With
    Do
        With rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchWildcards = True
            .text = "^13[!^13]@^t"
            If .Execute And rng.End <= rngEnd Then
                .text = "[,:; ]"
                .Replacement.text = "."
                .Execute Replace:=wdReplaceAll
            Else: Exit Do
            End If
            If rng.Characters.Last.Previous = "." Then
                rng.Characters.Last.Previous.Delete
            End If
            rng.Collapse wdCollapseEnd
        End With
    Loop
    Set rng = ActiveDocument.range
    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        .text = "(^13[0-9]{1;})^t"
        .Replacement.text = "\1.^t"
        .Execute Replace:=wdReplaceAll
    End With
ActiveDocument.range.Characters.First.Delete
Application.ScreenUpdating = True
Set rng = Nothing
End Sub

Shelley Lou · #4 08-08-2024, 08:21 AM

Hi Vivka, thanks for taking the time to update the code - unfortunately your code did not work for me, it threw up a few issues. I've posted a couple of images below.

Code not removing the very last at the end of levels 2-4 consistently
Capture1.JPG

Code separating text with a tab
Capture2JPG.JPG

I've added this to the beginning of the code which isn't ideal as it can't capture any other rogue punctuation without it affecting the rest of the document text e.g. instances at the end of paragraphs containing a semi colon (; and). Not as easy as I thought!!

Code:

Set rng = ActiveDocument.Range
    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        .text = "([.])([ ])([A-Za-z])"
        .Replacement.text = "^t\3"
        .Execute Replace:=wdReplaceAll
    End With

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode 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