word vba: select text between headings

Question

I have a word document in which I would like to select the full text of the heading starting with enumeration 2.3.1 until (not included) the heading 2.3.2 or [End of File]. If there are 'smaller' subsections or pictures or tables in between, they should also be selected.

PS: Example:

... 2.2 Blah Blah 2.3 Blubb Blubb [Start Selection] 2.3.1 Important1 Important2 [Picture: Important3] [Table: Important4] 2.3.1.1 Important 5 Important 6 [Stop Selection] 2.3.2 Blieh

I have experimented with navigating through every paragraph, but this is quite slow. I need this feature to copy the selection afterwards (I already know how to do that ;-)).

Thank you very much for help!

Jan

Answer 1

This seems to work well.
Adjust the format setting so that it finds '2.3.1' etc. only in that given format type.

Sub Macro1()
    Selection.WholeStory
    Selection.Collapse wdCollapseStart

    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Caption 1")
    With Selection.Find
        .Text = "2.3.1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
    End With
    Selection.Find.Execute
    Selection.Collapse wdCollapseStart

    Dim r1 As Range
    Set r1 = Selection.Range

    ' keep format settings, only change text
    Selection.Find.Text = "2.3.2"
    If Selection.Find.Execute Then
        Selection.Collapse wdCollapseStart
    Else
        Selection.WholeStory
        Selection.Collapse wdCollapseEnd
    End If
    Dim r2 As Range
    Set r2 = ActiveDocument.Range(r1.Start, Selection.Start)
    r2.Select

End Sub

Answer 2

This is the VBA Macro I'm using to select the text between headings. However, it only selects between any two headings of any level. It won't include smaller subheadings.

Sub SelectBetweenHeadings()
    With Selection
        .GoTo What:=wdGoToHeading, Which:=wdGoToPrevious
        .Collapse
        Dim curRange As Range
        Set curRange = .Range
        .Extend
        .GoTo What:=wdGoToHeading, Which:=wdGoToNext
        If .Range = curRange Then
            .EndKey Unit:=wdStory
        End If
        .ExtendMode = False
    End With
End Sub