Word VBA function to find a specified heading & return its text as a string

In this post, I asked for an overall review of a script to auto-generate table captions, because it was running relatively slowly. I've used Debug.Print to isolate the problem, and this function takes the longest (at 16 seconds).

The purpose of the function is to find the heading of a specified style that the selected text falls under. It loops back through each paragraph to see if it's the right style. When it finds it, it returns the paragraph text as a string (which the larger script uses to generate the table caption).

Any suggestions for improvement are welcome, but I'd specifically like performance improvement suggestions, as well as feedback on how long a function like this should take (i.e., is it slow or am I just impatient?)

Public Function FindHeading(strHeadLevel As String) As String
'Gets the heading level as an input and finds the closest heading of that level before the selection.

    Dim rngSelection As Range
    'the initial selection

    Dim rngPrev As Range
    'The current paragraph to be evaluated.

    Set rngSelection = Selection.Range
    Set rngPrev = rngSelection.Previous(wdParagraph, 1)

    'MsgBox (rngPrev.Text)

    Do While rngPrev.Style <> strHeadLevel

        If ActiveDocument.Range(0, rngPrev.Paragraphs(1).Range.End).Paragraphs.Count > 1 Then
            Set rngPrev = rngPrev.Previous(wdParagraph, 1)
            'MsgBox ("rngPrev Style =  " & rngPrev.Style & vbCr & "Text = " & rngPrev.Text)
        Else
            'MsgBox ("Heading not found")
            Exit Do
        End If

    Loop

    If rngPrev.Style = strHeadLevel Then
        FindHeading = rngPrev.Paragraphs(1).Range.Text
    Else
        FindHeading = "No heading found"
    End If

End Function

No need for a loop at all; just use Word's built-in ability to find text based on its style and other formatting.

Like so:

Public Function FindHeading(strHeadLevel As String) As String
    Dim rng As Range

    'set a range to the selection first so we can avoid
    '  the selection jumping around as we do our find
    Set rng = Selection.Range

    With rng.Find
        'set up our find criteria
        .ClearAllFuzzyOptions
        .ClearHitHighlight
        .ClearFormatting
        .Text = ""
        'search from current location back to start of document
        .Forward = False
        'and stop when we hit the start
        .Wrap = wdFindStop
        'here's the important part
        .Format = True
        .Style = strHeadLevel

        'now do our find
        If .Execute Then
            '.Parent contains the found range
            Set rng = .Parent
            'strip off trailing paragraph mark
            rng.MoveEnd unit:=wdCharacter, Count:=-1
            'grab the text of the found range
            FindHeading = rng.Text
        Else
            'we ain't got nothing
            FindHeading = "No heading found"
        End If
    End With
End Function

StackExchange Code Review Q#134998, answer score: 8