Removing characters from the start of multiple style paragraph in VBA for Word

Question

This is a follow-up question to my question (How to search/find for multiple format styles in VBA for Word?). This time instead of inserting a text to the beginning of each heading, we want to remove a few characters from the start of each heading after navigating to a heading titled 'Appendix'.

Trying to get rid of the first number along with the following white space or a period for multi-style paragraphs. For example, we would have headings with '4 Appendix A', '5.1 Intro', '10.2.3 Glossary...', which would be renamed to 'Appendix A', '1 Intro', '2.3 Glossary...'.

I removed the Selection.TypeText Text:=" *Test* " Selection.MoveStart wdParagraph, 1 lines after navigating to the Appendix section and replaced Selection.TypeText Text:=" *Test* " in the If found Then statement with the code seen below.

`If found Then
    Selection.HomeKey Unit:=wdLine
    If IsNumeric(Selection.Characters(2) = True) Then
       Selection.Delete Unit:=wdCharacter, Count:=3
       Selection.MoveStart wdParagraph, 1
    ElseIf IsNumeric(Selection.Characters(1) = True) Then
       Selection.Delete Unit:=wdCharacter, Count:=2
       Selection.MoveStart wdParagraph, 1
    Else
       Selection.MoveStart wdParagraph, 1
    End If
 End If`

Getting run-time error '5941' - The requested member of the collection does not exist. If IsNumeric(Selection.Characters(2) = True) Then seems to be the cause of the error. If I change the '2' to a '1' and Count:=3 to Count:=2 in the If statement and '1' to a '2' and Count:=2 to Count:=3 in theElseIf, then the code is executable. This is a problem because it doesn't recognize theElseIf` and only deletes 2 characters for a double-digit number leaving an unwanted white-space or period, i.e., '.2.3 Glossary...' or ' Appendix G'.

Answer 1

The reason for the error 5941 due to Characters(2). This is not doing what you imagine. That gets the second character, only, from the selection, not two characters. And the selection is a blinking insertion point so does not contain two characters. The error says: You're telling me to get the second character, but there aren't two characters, so I can't give you what you require.

Another problem in that line (that you're not seeing, yet): The parenthesis should be before the =, not after the True: If IsNumeric(Selection.Characters(2)) = True.

Since it's necessary to test multiple characters, the selection (or Range) needs to be extended. Word VBA offers a number of "Move" methods; the equivalent to holding Shift and pressing right-arrow on the keyboard is MoveEnd, and there are variations of this such as MoveEndWhile and MoveEndUntil that allow you to specify conditions. Optionally, these can return the number of characters that were moved (as done in the code below).

The following approach uses MoveEndWhile to first get numeric characters (until the next is no longer numeric): MoveEndWhile("0123456789", wdForward)... Followed by extending until the next character is no longer a ..

This Range is then deleted. (There's also a Debug.Print line in there to print out the content of the Range and the number of characters moved, in case that information interests you - just remove the comment mark ').

Note that I've included the entire code, in case others are interested in seeing it in its entirety. The parts from the previous question that are no longer relevant have been removed. You'll find the new part marked as '''NEW CODE HERE.

Sub AppendixFix()

    ' Declaring variables
    Dim multiStyles As String, i As Integer
    Dim aStyleList As Variant
    Dim counter As Long, s As String, found As Boolean
    Dim rngStart As Range

    multiStyles = "Heading 1,Heading 2,Heading 3,Heading 4,Heading 5,Heading 6,Heading 7,Heading 8,Heading 9"
    aStyleList = Split(multiStyles, ",")

    ' Start at the top of document and clear find formatting
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting

    ' Navigate to Appendix section
    Selection.Find.style = ActiveDocument.styles("Heading 1")
    With Selection.Find
        .Text = "Appendix"
        .Forward = True
        .wrap = wdFindStop
        .Format = True
        .Execute
    End With
    Selection.HomeKey Unit:=wdLine
    Set rngStart = Selection.Range.Duplicate

    ' Loop through all the styles in the list
    For counter = LBound(aStyleList) To UBound(aStyleList)
        'Loop as long as the style is found
        Do
            s = aStyleList(counter)
            With Selection.Find
                .style = ActiveDocument.styles(s)
                .Text = "^p"
                .Forward = True
                .wrap = wdFindStop
                .Format = True
                found = .Execute
            End With
'''NEW CODE HERE                
            Dim rngStartOfLine As Range
            Dim charsMovedNumeric As Long, charsMovedDot
            If found Then
                Selection.HomeKey Unit:=wdLine
                Set rngStartOfLine = Selection.Range
                charsMovedNumeric = rngStartOfLine.MoveEndWhile("0123456789", wdForward)
                charsMovedDot = rngStartOfLine.MoveEndWhile(".")
                'Debug.Print rngStartOfLine, charsMovedNumeric, charsMovedDot
                rngStartOfLine.Delete
                Selection.MoveStart wdParagraph, 1    
             End If
'''END OF NEW CODE
            If Selection.Start = ActiveDocument.content.End - 1 Then
                'End of Document, then loop to next style in list
                Exit For
            End If
        Loop Until found = False
        'start back at the Appendix for the next style
        rngStart.Select
    Next
End Sub