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 IfEnd Function
Word VBA function to find a specified heading & return its text as a string
performance;beginner;vba;ms word
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 WithEnd Function