Find nearest Heading above the MS Word table - vba

Question

I am enumerating tables in Microsoft Word in a following way:
Dim doc As Document, t As Table
Set doc = ActiveDocument
For Each t In doc.Tables
Next t
Now I would like to find the nearest paragraph with "Heading 2" style above the table and get it's text into a variable. Great if it could be accomplished without changing the selection focus in the document.
I can enumerate paragraphs in the document, but how to determine that some paragraph is above some table?

Answer 1

I solved that by building a list of paragraph start positions:
Private Type CaptionRec
Text As String
EndPos As Long
End Type
Dim caps() As CaptionRec
Dim i As Long
Dim p As Paragraph
ReDim caps(0)
i = 0
For Each p In doc.Paragraphs
If p.Style = "Überschrift 2" Then
i = i + 1
ReDim Preserve caps(i)
caps(i).Text = TrimGarbageAtEnd(p.Range.Text)
caps(i).EndPos = p.Range.Start 'Ok, this should be the end, not the start
End If
Next p
... and finding the minimum distance between table start and a "Heading 2" paragraph from array:
Public Function GetClosestCaption(tableStart As Long, ByRef caps() As CaptionRec) As String
Dim cap As CaptionRec, distance As Long, minDistance As Long, res As String, i As Long
minDistance = 2147483647 'Max long
res = ""
For i = LBound(caps) To UBound(caps)
cap = caps(i)
distance = tableStart - cap.EndPos
If distance >= 0 Then
If distance < minDistance Then
minDistance = distance
res = cap.Text
End If
End If
Next i
GetClosestCaption = res
End Function
The routine gets called in a following loop:
Public Sub MainRoutine()
For Each t In doc.Tables
If table_validity_criteria_go_here Then
caption = GetClosestCaption(t.Range.Start, caps)
For Each r In t.Rows
'Enumerate rows
Next r
End If
Next t
End Sub

Answer 2

An alternative is to reverse the logic. Instead of processing the tables and then looking for the associated heading, find the headings then process the tables within the range of the heading level, For example:
Sub FindHeading2Ranges()
Dim findRange As Range
Dim headingRange As Range
Set findRange = ActiveDocument.Content
With findRange.Find
.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.Format = True
.Style = ActiveDocument.Styles(wdStyleHeading2)
Do While .Execute
Set headingRange = findRange.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
If headingRange.Tables.Count > 0 Then
ProcessTables headingRange, TrimGarbageAtEnd(findRange.text)
End If
findRange.Collapse wdCollapseEnd
Loop
End With
End Sub
Sub ProcessTables(headingRange As Range, caption As String)
Dim t As Table
For Each t In headingRange.Tables
If table_validity_criteria_go_here Then
For Each r In t.Rows
'Enumerate rows
Next r
End If
Next t
End Sub