How to search/find for multiple format styles in VBA for Word?

Question

Thanks in advance for taking the time to read this.

I would like to code the Find function in Word 2013 for searching specific words in multiple styles. Not even sure if this is possible because Word doesn't have that option in Advanced Find --> More --> Format --> Style. It only allows for filtering one style.

My goal is to be able to find paragraph marks (syntax: ^p) on styles 'Heading 1' through 'Heading 9'.

Sub AppendixFix()

    ' Declaring variables
    Dim multiStyles As String, i As Integer
    multiStyles = "Heading 1, Heading 2, Heading 3, Heading 4, Heading 5, Heading 6, Heading 7, Heading 8, Heading 9"

    ' 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 = wdFindAsk
        .Format = True
        .Execute
    End With

    ' Loop until find is not found and limit to 1000 counts
    Do While Selection.Find.Found = True And i < 1000
        i = i + 1
        ' Add text to the beginning of each line
        Selection.HomeKey Unit:=wdLine
        Selection.TypeText Text:=" *Test* "
        ' Navigate to the next heading by looking at following paragraph mark
        Selection.Find.Style = ActiveDocument.Styles(multiStyles)
        With Selection.Find
            .Text = "^p"
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .Execute
            .Execute
        End With
    Loop

End Sub

I expected the code to start inputting Test at the first 'Appendix' heading, then inputs Test to its sub-headings (Heading 2, 3..., 9), and continues to the end of the document. However, it only adds the text to Heading 1-styled headers skipping its sub-headers. It seems to me that only the first style in the list gets read in. I've tried removing Heading 1 from the list and it checks for Heading 2-styled headers.

Cindy Meister · Accepted Answer

The following worked for me in a test document based on what I understand the set up of the document in the question is.

The code needs to loop the styles. In order to do this, the styles need to be in something that can be looped - an array. The Split method splits up a list into an array, based on a delimiter. The delimiter can be only one character, so the spaces after the commas need to be removed from multiStyles in the code in the question.

When looping, it's important to return to the starting point (Appendix) for each style. For that, the code below uses a Range object.

The "Test" text should only be added if something is found. The code below uses a boolean variable to store what Find.Execute returns (true if found) so that this as well as the Loop Until can be tested reliably.

It's possible that a Find can end up at the end of the document. In that case, the code goes into an endless loop, so there's a test for the end position to move to the next style in the list.

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
    Selection.TypeText Text:=" *Test* "
    Selection.MoveStart wdParagraph, 1
    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

            ' Add text to the beginning of each line
            If found Then
                Selection.HomeKey Unit:=wdLine
                Selection.TypeText Text:=" *Test* "
                Selection.MoveStart wdParagraph, 1
            End If
            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

How to search/find for multiple format styles in VBA for Word?

Answers (2)

Related Questions