VBA Run Time Error 91

Shelley Lou · #1 09-10-2024, 07:03 AM

I had help from Vivka putting this code together but I've since updated the code so it will only run if text has been selected within the document. In the test document attached, I want to select all the text from 1 CABINET SUB-COMMITTEES down to clause 3.12 but I'm getting a run time error 91 occur. I've tested the code and if I select the text from 1 CABINET SUB-COMMITTEES down to 3.10. the code works, also if I select clauses 3.11 and 3.12 only the code works so I'm not sure why it errors out selecting all the text from manual clause 1 down to 3.12. Can anyone help at all.

This part of the code is where it errors

Code:

'Delete all periods immediately before a tab:
            While rng.Characters.Last.Previous = "."

Test format numbers on selection.docx

Code:

Sub FormatManualNumbering()
Dim rng As Range
Dim rngEnd As Long
Dim i As Paragraph, N As Long
Application.ScreenUpdating = False
'Call DeleteEmptyParas
'Call DPU_RemoveFirstLineIndents
If Selection.Type = wdSelectionIP Then
 MsgBox Prompt:="You have not selected any text!"
 Exit Sub
End If
With Selection.Range
Set rng = Selection.Range
With rng
'Removes any indents at beginning of paragraphs
For Each i In Selection.Paragraphs 'cycling in the pragraphs of the active document
For N = 1 To i.Range.Characters.count
If i.Range.Characters(1).text = " " Or i.Range.Characters(1).text = "Char(32) " Or i.Range.Characters(1).text = "Char(32)\( " Or i.Range.Characters(1).text = Chr(9) Or i.Range.Characters(1).text = Chr(160) Or i.Range.Characters(1).text = Chr(40) Then
i.Range.Characters(1).Delete
Else: Exit For
End If
Next N
Next
End With
With Selection.Range
Set rng = Selection.Range
With rng.Find
'Remove space before brackets first line indent
    .ClearFormatting
    .Replacement.ClearFormatting
    .text = "^13 ("
        .Replacement.text = "^p("
     .Execute Replace:=wdReplaceAll
End With
With Selection.Range
    Set rng = Selection.Range
    rngEnd = rng.End
    Selection.Range.InsertBefore vbCr
       With rng.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 spaces before para signs:
        .text = "^w^p"
        .Replacement.text = "^p"
        .Execute Replace:=wdReplaceAll
'Remove empty paras:
        .MatchWildcards = True
        .text = "^13{2,}"
        .Replacement.text = "^p"
        .Execute Replace:=wdReplaceAll
'Insert a tab before any 1st letter in a para:
        .text = "(^13[!^13]@)([A-Za-z])"
        .Replacement.text = "\1^t\2"
        .Execute Replace:=wdReplaceAll
'Replace two tabs with one tab:
        .text = "^t^t"
        .Replacement.text = "^t"
        .Execute Replace:=wdReplaceAll
'Delete tabs between letters, which have been inserted using
'the code to insert a tab before any 1st letter in a para previously:
        .text = "([A-Za-z])^t([A-Za-z])"
        .Replacement.text = "\1\2"
        .Execute Replace:=wdReplaceAll
    End With
With Selection.Range
Set rng = Selection.Range
    Do
        With rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchWildcards = True
'Find a str between a tab & the nearest previous para sign, i.e.
'a str between a para sign & a tab, excluding other paras in-between:
            .text = "^13[!^13]@^t"
            If .Execute And rng.End <= rngEnd Then
                .text = "[,:; ]"
                .Replacement.text = "."
                .Execute Replace:=wdReplaceAll
            Else: Exit Do
            End If
'Delete all periods immediately before a tab:
            While rng.Characters.Last.Previous = "."
                rng.Characters.Last.Previous.Delete
            Wend
            rng.Collapse wdCollapseEnd
        End With
    Loop
'Reset rng (see the comment above):
    With Selection.Range
Set rng = Selection.Range
With rng.Find
         .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
'Insert periods after lone 1st-level numberings:
        .text = "(^13[0-9]{1,})^t"
        .Replacement.text = "\1.^t"
        .Execute Replace:=wdReplaceAll
'Delete extra periods in the doc:
        .text = "[.]{2,}"
        .Replacement.text = "."
        .Execute Replace:=wdReplaceAll
'Delete tab after opening bracket:
        .text = "(^13[(])^t"
        .Replacement.text = "\1"
        .Execute Replace:=wdReplaceAll
'Delete tab after opening double quote (Chr(34) & Chr(147)) after para marks:
        .text = "(^13" & "[" & Chr(34) & Chr(147) & "]" & ")^t"
        .Replacement.text = "\1"
        .Execute Replace:=wdReplaceAll
    End With
'Delete the doc's starting para sign inserted previously:
    Selection.Range.Characters.First.Delete
 Application.ScreenUpdating = True
MsgBox "Complete"
  End With
  End With
  End With
  End With
  End With
Set rng = Nothing
End Sub

mister19stick · #2 09-10-2024, 09:58 AM

you are iterating over a list that's changing.

how about Replacing dot-tab with just tab until there's none left?

vivka · #3 09-11-2024, 02:11 AM

Hi, Shelley Lou! 1) Your code works without a hitch (no errors returned) on my machine,
2) There were some duplicate / redundant code lines in your code, so after fine-tuning the code (I hope, I really did it) it may look as follows:

Code:

Sub FormatManualNumbering()
Dim rng As range
Dim rngEnd As Long

Application.ScreenUpdating = False

    If selection.Type = wdSelectionIP Then
       MsgBox Prompt:="You have not selected any text!"
       Exit Sub
    End If
    Set rng = selection.range
    rngEnd = rng.End

    selection.range.InsertBefore vbCr
    With rng.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 spaces before para signs:
       .text = "^w^p"
       .Replacement.text = "^p"
       .Execute Replace:=wdReplaceAll
'Remove empty paras:
       .MatchWildcards = True
       .text = "^13{2,}"
       .Replacement.text = "^p"
       .Execute Replace:=wdReplaceAll
'Insert a tab before any 1st letter in a para:
       .text = "(^13[!^13]@)([A-Za-z])"
       .Replacement.text = "\1^t\2"
       .Execute Replace:=wdReplaceAll
'Replace two tabs with one tab:
       .text = "^t^t"
       .Replacement.text = "^t"
       .Execute Replace:=wdReplaceAll
'Delete tabs between letters, which have been inserted using
'the code to insert a tab before any 1st letter in a para previously:
       .text = "([A-Za-z])^t([A-Za-z])"
       .Replacement.text = "\1\2"
       .Execute Replace:=wdReplaceAll
    End With
    Set rng = selection.range
    Do
        With rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchWildcards = True
'Find a str between a tab & the nearest previous para sign, i.e.
'a str between a para sign & a tab, excluding other paras in-between:
            .text = "^13[!^13]@^t"
            If .Execute And rng.End <= rngEnd Then
                .text = "[,:; ]"
                .Replacement.text = "."
                .Execute Replace:=wdReplaceAll
            Else: Exit Do
            End If
'Delete all periods immediately before a tab:
            While rng.Characters.Last.Previous = "."
                rng.Characters.Last.Previous.Delete
            Wend
            rng.Collapse wdCollapseEnd
        End With
    Loop
'Reset rng (see the comment above):
    Set rng = selection.range
    With rng.Find
           .ClearFormatting
           .Replacement.ClearFormatting
           .Forward = True
           .Wrap = wdFindStop
           .Format = True
           .MatchWildcards = True
'Insert periods after lone 1st-level numberings:
           .text = "(^13[0-9]{1,})^t"
           .Replacement.text = "\1.^t"
           .Execute Replace:=wdReplaceAll
'Delete extra periods in the doc:
           .text = "[.]{2,}"
           .Replacement.text = "."
           .Execute Replace:=wdReplaceAll
'Delete tab after opening bracket:
           .text = "(^13[(])^t"
           .Replacement.text = "\1"
           .Execute Replace:=wdReplaceAll
'Delete tab after opening double quote (Chr(34) & Chr(147)) after para marks:
           .text = "(^13" & "[" & Chr(34) & Chr(147) & "]" & ")^t"
           .Replacement.text = "\1"
           .Execute Replace:=wdReplaceAll
    End With
'Delete the doc's starting para sign inserted previously:
    selection.range.Characters.First.Delete
 Application.ScreenUpdating = True
MsgBox "Complete"
  
Set rng = Nothing
End Sub

Shelley Lou · #4 09-11-2024, 05:06 AM

Hello again Vivka, how strange that it works on your PC, I've just run your updated code but still getting the run time error 91 on this line

Code:

While rng.Characters.Last.Previous = "."

To further test I have selected just the text from 1 CABINET SUB-COMMITTEES down to 2.7.2. which worked but even though I had not select 3 Function of the Shareholders, the code still inserted a full stop after 3. I then selected the text from 3.1 to 3.12 but got the run time error. Any ideas?

vivka · #5 09-13-2024, 08:03 AM

Hi, Shelley Lou!
Hopefully, you'll like the following.

Code:

Sub FormatManualNumbering()

Dim rng As range
Dim rngEnd As Long

Application.ScreenUpdating = False
    If selection.Type = wdSelectionIP Then
        MsgBox Prompt:="You have not selected any text!"
        Exit Sub
    End If
    
    Set rng = selection.range

    rng.InsertBefore vbCr
    rngEnd = selection.End
    With rng.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 spaces before para signs:
        .text = "^w^p"
        .Replacement.text = "^p"
        .Execute Replace:=wdReplaceAll
'Remove empty paras:
        .MatchWildcards = True
        .text = "^13{2;}"
        .Replacement.text = "^p"
        .Execute Replace:=wdReplaceAll
'Insert a tab before any 1st letter in a para:
        .text = "(^13[!^13]@)([A-Za-z])"
        .Replacement.text = "\1^t\2"
        .Execute Replace:=wdReplaceAll
'Replace two tabs with one tab:
        .text = "^t^t"
        .Replacement.text = "^t"
        .Execute Replace:=wdReplaceAll
'Delete tabs between letters, which have been inserted using
'the code to insert a tab before any 1st letter in a para previously:
        .text = "([A-Za-z])^t([A-Za-z])"
        .Replacement.text = "\1\2"
        .Execute Replace:=wdReplaceAll
    End With
    rng.Select
    Set rng = selection.range
    Do
        With rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchWildcards = True
'Find a str between a tab & the nearest previous para sign, i.e.
'a str between a para sign & a tab, excluding other paras in-between:
            .text = "^13[!^13]@^t"
            If .Execute And rng.End <= rngEnd Then
                .text = "[,:; ]"
                .Replacement.text = "."
                .Execute Replace:=wdReplaceAll
            Else: Exit Do
            End If
'Delete all periods immediately before a tab:
            While rng.Characters.Last.Previous = "."
                rng.Characters.Last.Previous.Delete
            Wend
            rng.Collapse wdCollapseEnd
        End With
    Loop
    Set rng = selection.range
    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
'Insert periods after lone 1st-level numberings:
        .text = "(^13[0-9]{1;})^t"
        .Replacement.text = "\1.^t"
        .Execute Replace:=wdReplaceAll
'Delete extra periods in the doc:
        .text = "[.]{2;}"
        .Replacement.text = "."
        .Execute Replace:=wdReplaceAll
'Delete tab after opening bracket:
        .text = "(^13[(])^t"
        .Replacement.text = "\1"
        .Execute Replace:=wdReplaceAll
'Delete tab after opening double quote (Chr(34) & Chr(147)) after para marks:
        .text = "(^13" & "[" & Chr(34) & Chr(147) & "]" & ")^t"
        .Replacement.text = "\1"
        .Execute Replace:=wdReplaceAll
    End With
'Delete the doc's starting para sign inserted previously:
    selection.range.Characters.First.Delete
    Application.ScreenUpdating = True
    MsgBox "Complete"
Set rng = Nothing
End Sub

Shelley Lou · #6 09-25-2024, 06:27 AM

Hi Vivka, thank you for the updated code, unfortunately I'm still getting the error 91 when I select all the text in the test document so I'm a bit baffled to say the least as it seems you are running the code without any errors. If I only select text down to the last few paragraphs it works bizarrely. I will keep trying to get it right.

vivka · #7 09-25-2024, 09:17 AM

Hu, Shelley Lou! I tested the code only on plain text (and it worked perfectly), not on tables. You initially asked for a code to work on manual list numberings, but your sample document has tables with automatic numberings, that's why .text = "^13[!^13]@^t" makes wrong finds, which causes the error.
Please, try this version:

Code:

Sub FormatManualNumbering()
Dim rng As range
Dim rngEnd As Long

Application.ScreenUpdating = False
    If selection.Type = wdSelectionIP Then
        MsgBox Prompt:="You have not selected any text!"
        Exit Sub
    End If
    
    Set rng = selection.range
    rng.InsertBefore vbCr
    rngEnd = selection.End
    With rng.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 spaces before para signs:
        .text = "^w^p"
        .Replacement.text = "^p"
        .Execute Replace:=wdReplaceAll
'Remove empty paras:
        .MatchWildcards = True
        .text = "^13{2,}"
        .Replacement.text = "^p"
        .Execute Replace:=wdReplaceAll
'Insert a tab before any 1st letter in a para:
        .text = "(^13[!^13]@)([A-Za-z])"
        .Replacement.text = "\1^t\2"
        .Execute Replace:=wdReplaceAll
'Replace two tabs with one tab:
        .text = "^t^t"
        .Replacement.text = "^t"
        .Execute Replace:=wdReplaceAll
'Delete tabs between letters, which have been inserted using
'the code to insert a tab before any 1st letter in a para previously:
        .text = "([A-Za-z])^t([A-Za-z])"
        .Replacement.text = "\1\2"
        .Execute Replace:=wdReplaceAll
    End With
    rng.Select
    Set rng = selection.range
    Do
        With rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchWildcards = True
'Find a str between a tab & the nearest previous para sign, i.e.
'a str between a para sign & a tab, excluding other paras in-between:
            .text = "^13[!^13]@^t"
'Skip tables:
            If .Execute And rng.Information(wdWithInTable) = False And rng.End <= rngEnd Then
                 .text = "[,:; ]"
                .Replacement.text = "."
                .Execute Replace:=wdReplaceAll
            Else: Exit Do
            End If
            rng.Collapse wdCollapseEnd
        End With
    Loop
    Set rng = selection.range
    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
'Delete all periods immediately before a tab:
        .text = "[.]{1,}^t"
        .Replacement.text = "^t"
        .Execute Replace:=wdReplaceAll
'Insert periods after lone 1st-level numberings:
        .text = "(^13[0-9]{1,})^t"
        .Replacement.text = "\1.^t"
        .Execute Replace:=wdReplaceAll
'Delete extra periods in the doc:
        .text = "[.]{2,}"
        .Replacement.text = "."
        .Execute Replace:=wdReplaceAll
'Delete tab after opening bracket:
        .text = "(^13[(])^t"
        .Replacement.text = "\1"
        .Execute Replace:=wdReplaceAll
'Delete tab after opening double quote (Chr(34) & Chr(147)) after para marks:
        .text = "(^13" & "[" & Chr(34) & Chr(147) & "]" & ")^t"
        .Replacement.text = "\1"
        .Execute Replace:=wdReplaceAll
    End With
'Delete the doc's starting para sign inserted previously:
    selection.range.Characters.First.Delete
    Application.ScreenUpdating = True
    MsgBox "Complete"
Set rng = Nothing
End Sub

Shelley Lou · #8 09-26-2024, 03:23 AM

Hi Vivka, the code should only run on text that is selected i.e. text selected directly after the table at clause 1.1 and before schedule 1, hopefully the way the code is written it should only work on selected text and nothing else in the document (the test document is how our leases are set up with tables and just for info purposes).

The idea was I was hoping the code only worked on selected text, if I copy and paste the text into a blank document (i.e. with no tables etc.) it does work, so I've gone back to that way to use the code and then once updated I copy it back into the lease document. Bit long winded but its how it will only work at the moment.

Unfortunately when running your new code it ended up in an endless loop and I had to shut Word down.

Thanks so much for all the help though, I really do appreciate it.

vivka · #9 09-26-2024, 06:18 AM

The code from post #5 works like charm on any ranges but tables. I didn't see any issue. Very strange!

Shelley Lou · #10 09-26-2024, 08:18 AM

Vivka, I wonder if its because you use semi colons and I have to use a comma e.g. {1;} to my {1,}, maybe that has something to do with it - long shot I know. I will close this thread now though as I don't think we can go any further with it now but thanks for all your help, always appreciated

vivka · #11 09-26-2024, 09:09 AM

You are welcome, Shelley Lou! I'm sorry I couldn't help you!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Why am I getting this run time error?	MaxPower	Excel	2	12-31-2023 01:31 AM
Word template with Macro keeps getting an error ''Run-time error 5941''	Marcel	Word VBA	3	12-17-2019 04:55 PM
Word Error Message Run time Error 4605	baes10	Word VBA	1	08-30-2018 02:37 PM
Get Run-time Error 11	Jamtart	PowerPoint	2	08-31-2012 05:04 AM
Word Visual Basic error - run time error 504	crazymorton	Word	11	01-13-2012 04:32 AM