First things first, let's clean everything up.
Proper descriptive naming, proper validation variables, making the code clear and obvious about what's happening where
Public Function GetHeadingFromStyle(ByVal styleToFind As String) As String
'/ Iteratively checks the style of all paragraphs, starting at the current selection and working towards the start of the document.
'/ If the style matches the inputStyle, return the text of the paragraph.
'/ If no match is found, return "No heading Found"
Const NO_HEADING_FOUND_TEXT As String = "No heading Found"
Dim currentRange As Range
currentRange = Selection.Range
Dim wholeDocumentSearched As Boolean
wholeDocumentSearched = False
Dim headingFound As Boolean
headingFound = False
Do Until headingFound Or wholeDocumentSearched
Set currentRange = currentRange.Previous(wdParagraph, 1)
headingFound = (currentRange.Style = styleToFind)
wholeDocumentSearched = ActiveDocument.Range(0, currentRange.Paragraphs(1).Range.End).Paragraphs.Count = 0
Loop
If headingFound Then
GetHeadingFromStyle= currentRange.Paragraphs(1).Range.Text
Else
GetHeadingFromStyle= NO_HEADING_FOUND_TEXT
End If
End Function
Okay, here's where we're taking so much time:
Do Until headingFound Or wholeDocumentSearched
Set currentRange = currentRange.Previous(wdParagraph, 1)
headingFound = (currentRange.Style = styleToFind)
wholeDocumentSearched = ActiveDocument.Range(0, currentRange.Paragraphs(1).Range.End).Paragraphs.Count = 0
Loop
You mentioned in your previous question that these documents could be 1,000+ pages. Iteratively looping over something that huge is going to be slow. What we need is some kind of map/lookup.
I'm not very familiar with the Word object model, so there might be something blindingly obvious/easy I'm missing. That aside, here are ideas:
Idea #1:
Map the entire document once and then reference the map. This will mean having a slow execution once, and then all subsequent searches should be lightning fast.
Note, this only works if the document structure is not going to change between some number of iterations (5-10 would be a good minimum). Because as soon as a new paragraph gets inserted/deleted/moved, our entire map is going to be inaccurate.
So, something like this:
Option Explicit
Public ParagraphStyles As Variant
Public Const INDEX_INDEX2 As Long = 1 '/ index2 to distinguish between dimensions of the array
Public Const STYLE_INDEX2 As Long = 2
Public Sub SetupDocumentSearch()
ParagraphStyles = MapParagraphStyles
'/ Call Main sub here
End Sub
Public Function MapParagraphStyles(ByRef targetDocument As Document)
'/ Loop through the document and, for each paragraph:
'/ Add the paragraph Index and Style to an array
With targetDocument
Dim styleMap As Variant
ReDim styleMap(1 To .Paragraphs.Count, 1 To 2)
Dim currentParagraph As Range
Dim paragraphCounter As Long
For paragraphCounter = 1 To .Paragraphs.Count
styleMap(paragraphCounter, INDEX_INDEX2) = indexcounter
styleMap(paragraphCounter, STYLE_INDEX2) = .Paragraphs(indexcounter).Style
Next paragraphCounter
End With
MapParagraphStyles = styleMap
End Function
Then we can loop over an array searching for our style. Iterating over arrays is orders of magnitude faster than working with high-level objects like documents:
Public Function GetHeadingFromStyle(ByVal styleToFind As String) As String
'/ Iteratively checks the style of all paragraphs, starting at the current selection and working towards the start of the document.
'/ If the style matches the inputStyle, return the text of the paragraph.
'/ If no match is found, return "No heading Found"
Const NO_HEADING_FOUND_TEXT As String = "No heading Found"
Dim paragraphIndex As Long
paragraphIndex = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count
Dim wholeDocumentSearched As Boolean
wholeDocumentSearched = False
Dim headingFound As Boolean
headingFound = False
Do Until headingFound Or wholeDocumentSearched
paragraphIndex = paragraphIndex - 1
headingFound = ParagraphStyles(paragraphIndex, STYLE_INDEX2) = styleToFind
wholeDocumentSearched = (paragraphIndex = 1)
Loop
If headingFound Then
GetHeadingFromStyle = ActiveDocument.Paragraphs(paragraphIndex).Range.Text
Else
GetHeadingFromStyle = NO_HEADING_FOUND_TEXT
End If
End Function