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!!!