Need Word macro to make list of "defined terms"

need word macro automatically search "defined terms" in legal document (words or phrases in "quote marks") , make list of them , page numbers on can found.

resulting list ideally have 2 columns on page, , each column following:

affiliate . . . . . . . . . . 50 | property . . . . . . . 3, 56
assignment . . . . . 60, 65 | seller . . . . . . . . . . . 1
buyer . . . . . . . . . . . . 1 | transfer . . . . . . . . . 34
completion date . . . . 23 |

, on.

have no word macro skills. wrote macro wordperfect twelve years ago (long lost), complexities of word macros way beyond me.

our version of office 2003, , os xp pro sp3.

thanks.

hi glnz,

relying on paired double quotes problematic, may encompass quoted statement or 1 of pair may missing.

the following macro takes different approach, using separate word file holds key terms. approach means that, once create word file key terms, can use document. table produced macro include terms found in document being processed. need change 'drive:\filepath\keyterms.doc' point own 'key terms' document.

a refinement i've made reporting terms appear on 3 or more consecutive pages list first & last hyphen separator. if don't want refinement, change 'parsepagerefs(strpages)' 'strpages' , delete 'parsepagerefs' function appears below sub.

sub tabulatekeyterms()
application.screenupdating = false
dim doc document, refdoc document, rng range
dim strterms string, strfnd string, strpages string
dim long, j long, strout string, strbreak string
strout = "term" & vbtab & "pages" & vbtab & "term" & vbtab & "pages" & vbcr
set doc = activedocument
set refdoc = documents.open("drive:\filepath\keyterms.doc", addtorecentfiles:=false)
strterms = refdoc.range.text
refdoc.close false
set refdoc = nothing
= 0 ubound(split(strterms, vbcr))
  strfnd = trim(split(strterms, vbcr)(i))
  if strfnd = "" goto nullstring
  strpages = ""
  doc.content
    .find
      .clearformatting
      .replacement.clearformatting
      .format = false
      .text = strfnd
      .wrap = wdfindstop
      .matchwholeword = true
      .matchwildcards = false
      .matchcase = true
      .execute
    end with
    j = 0
    while .find.found
      if j <> .duplicate.information(wdactiveendpagenumber) then
        j = .duplicate.information(wdactiveendpagenumber)
        strpages = strpages & j & " "
      end if
      .find.execute
    loop
    strpages = replace(trim(strpages), " ", ",")
    if strpages <> "" then
      if mod 2 = 0 strbreak = vbtab else strbreak = vbcr
      strout = strout & strfnd & vbtab & parsepagerefs(strpages) & strbreak
    end if
  end with
nullstring:
next i
set rng = doc.range.characters.last
rng
  .insertafter vbcr & chr(12) & strout
  .start = .start + 2
  .converttotable separator:=vbtab, numcolumns:=4, autofitbehavior:=wdautofitcontent, autofit:=true
  .tables(1).rows.first.range
    .paragraphformat.alignment = wdalignparagraphcenter
    .font.bold = true
  end with
end with
application.screenupdating = true
end sub

function parsepagerefs(strpages string)
dim arrtmp(), integer, j integer, k integer
redim arrtmp(ubound(split(strpages, ",")))
= 0 ubound(split(strpages, ","))
  arrtmp(i) = split(strpages, ",")(i)
next
= 0 ubound(arrtmp) - 1
  if isnumeric(arrtmp(i)) then
    k = 2
    j = + 2 ubound(arrtmp)
      if cint(arrtmp(i) + k) <> cint(arrtmp(j)) exit for
      arrtmp(j - 1) = ""
      k = k + 1
    next
    = j - 1
  end if
next
parsepagerefs = replace(replace(replace(replace(join(arrtmp, ","), ",,", " "), " ,", " "), "  ", " "), " ", "-")
end function

---

cheers
paul edstein
[ms mvp - word]

Microsoft Office  >  Word IT Pro Discussions