Macro to collect section references for a defined term

[jhen]

I have a legal document that is formatted with different heading styles such as Article I, II /Section 2.01, 2.02/ (a), (b)/ (i), (ii), etc. They are Headings 1, 2, 3 and 4. I want to list all the section references of a defined term in a new document. For example, "Apple" appears in Section 2.01(a)(i) and in Section 10.05(b)(ii)(D) so I want to have a new document that says Apple: Section 2.01(a)(i), Section 10.05(b)(ii)(D). I may have multiple terms that I want to run the search for and I want the results to be saved in one document.

I found this great macro written by macropod while doing online searches (need to replace* with : since the forum does not allow me to post links yet). This is exactly what I want but instead of listing all the page numbers, I want to list all these section number references. Is this doable? This is way above my level. I do not even know how to get these numbering references in the first place. Thanks!!!

https*//social.technet.microsoft.com/Forums/ie/en-US/228d49ed-53a4-487f-9829-316f76abbe13/need-word-macro-to-make-list-of-defined-terms?forum=word

[macropod]

There are numerous 'flavours' of the macro in that thread: the first one assumes the terms are pre-defined in a separate document; later ones assume only that the terms can be identified by their enclosure in double quotes. To which do you refer?

[jhen]

Thanks for the quick response!!! A pre-defined separate document is totally fine. Not all defined terms are created equal (like "Business Day", "Person", which will be literally used in every other sentence) so I am only interested in a few key definitions that I can type out in a separate document if needed.

[macropod]

It would help if you could upload a sample document containing a representative sample of the content you want to capture, as the complexity of coding for the numbering scheme depends on how that multi-level numbering is implemented.

[jhen]

Thanks!!! Here is a short sample document. The documents are formatted with H1, H2 and H3 headings. For example, how can I run the macro to list all the places where the term Material Adverse Effect is used? The result report will be something like this: Material Adverse Effect: Section 3.11, Section 3.12(a), Section 3.12(b), Section 3.13......

[macropod]

Try:

Sub TabulateDefinedTerms()
Application.ScreenUpdating = False
Dim Doc As Document, RefDoc As Document, Rng As Range
Dim StrTerms As String, strFnd As String, i As Long, j As Long
Dim StrLvl As String, StrTmp As String, StrOut As String, StrBreak As String
StrOut = "Term" & vbTab & "Refs" & vbTab & "Term" & vbTab & "Refs" & vbCr
Set Doc = ActiveDocument
Set RefDoc = Documents.Open("Drive:\FilePath\KeyTerms.doc", AddToRecentFiles:=False)
StrTerms = RefDoc.Range.Text: RefDoc.Close False
For i = 0 To UBound(Split(StrTerms, vbCr))
strFnd = Trim(Split(StrTerms, vbCr)(i))
If strFnd = "" Then GoTo NullString
StrTmp = ""
With Doc.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strFnd
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWildcards = False
.Execute
End With
Do While .Find.Found
Set Rng = .Duplicate: j = Rng.ListFormat.ListLevelNumber
StrLvl = Rng.ListFormat.ListString: If j = 1 Then j = 9
Do While Rng.Paragraphs.First.Range.Style <> "H2"
Rng.Start = Rng.Start - 1
Rng.Collapse wdCollapseStart
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
With Rng.Paragraphs.First.Range.ListFormat
If j > .ListLevelNumber Then
StrLvl = .ListString & " " & StrLvl
j = .ListLevelNumber
End If
End With
Loop
StrTmp = StrTmp & Trim(StrLvl) & ", "
.Start = .Paragraphs.First.Range.End
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
StrTmp = Left(StrTmp, Len(StrTmp) - 2)
If i Mod 2 = 0 Then StrBreak = vbTab Else StrBreak = vbCr
StrOut = StrOut & strFnd & vbTab & StrTmp & StrBreak
NullString:
Next
Set Rng = Doc.Range.Characters.Last
With Rng
.InsertAfter vbCr & Chr(12) & StrOut
.Start = .Start + 2
.ConvertToTable Separator:=vbTab, Numcolumns:=4, AutoFitBehavior:=wdAutoFitContent, AutoFit:=True
With .Tables(1).Rows.First
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Font.Bold = True
.HeadingFormat = True
End With
End With
Application.ScreenUpdating = True
End Sub
Note that you'll need to replace 'Drive:\FilePath\KeyTerms.doc' with the correct path & filename for the document holding the defined terms, each of which should consist of a single paragraph.

[jhen]

Totally works!!! Thank you so much!!!