Hi Jana,
Here's an improved version - it allows you to pick the Heading level!
Code:
Sub InsertRefs()
Application.ScreenUpdating = False
Dim RngHdA As Range, RngHdB As Range, RngRef As Range
Dim iRefHd As Long, StrTxt As String, oPara As Paragraph
On Error Resume Next
iRefHd = InputBox("What is the Reference Heading Level Number (from 1 to 8)?", "Heading Selector")
' Word's inbuilt heading styles are indexed as -2 to -10, so invert the input # and subtract 1
iRefHd = -iRefHd - 1
On Error GoTo 0
' Valid #s must be between -2 (Heading 1) and -9 (Heading 8)
If iRefHd > -2 Or iRefHd < -9 Then Exit Sub
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Style = iRefHd
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
Set RngHdA = .Paragraphs(1).Range.Duplicate
With RngHdA
On Error GoTo ParaLast
While ActiveDocument.Styles(.Paragraphs.Last.Next.Style).BuiltIn = False Or _
.Paragraphs.Last.Next.Style > ActiveDocument.Styles(iRefHd) Or _
.Paragraphs.Last.Next.Style < ActiveDocument.Styles(iRefHd + 1)
.MoveEnd wdParagraph, 1
Wend
ParaLast:
StrTxt = ""
If .Paragraphs.Count > 2 Then
Set RngRef = RngHdA.Paragraphs(3).Range.Characters.Last
.MoveStart wdParagraph, 3
Set RngHdB = RngHdA
With RngRef
.MoveEnd wdCharacter, -2
For Each oPara In RngHdB.Paragraphs
If ActiveDocument.Styles(oPara.Style).BuiltIn = True Then
' To get all lower Heading Styles, change '(iRefHd - 2)' to '(-11)'
If oPara.Style < ActiveDocument.Styles(iRefHd - 2) And _
oPara.Style > ActiveDocument.Styles(iRefHd) Then
If Len(Trim(oPara.Range.Text)) > 1 Then
StrTxt = StrTxt & Left(oPara.Range.Text, Len(oPara.Range.Text) - 1) & ", "
End If
End If
End If
Next
If Len(StrTxt) > 0 Then
StrTxt = "{" & Left(StrTxt, Len(StrTxt) - 2) & "}"
.InsertAfter StrTxt
End If
End With
End If
End With
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
As coded, the macro only looks reports Heading Styles one level below the chose one. To get all lower Heading Styles, change '(iRefHd - 2)' to '(-11)' where indicated in the code.