Macro needed to generate an Abbreviations and Acronyms List for MS Word 2007

Topic

New Reply

Hello,

I am looking to see if there is some type of Macro out there for MS Word 2007 that can:

1. Search through a MS Word document several hundred pages long
2. Identify all terms, abbreviations and acronyms
3. Generate a list that could be added to an Abbreviations and Acronyms list at the beginning
of the Word document.

Note: I realize that any list like this generated would need some clean up at the end. But, I am hoping to get some
type of macro that can do a rough search and generate a list, that can potentially be used in an Abbreviation and Acronyms list.

Thanks for any assistance you can provide/offer on this request.

Regards,

Jim

Reply | Quote

Replies

For some code to get you started, see:
http://www.msofficeforums.com/word-vba/19395-acronym-finder-macro-microsoft-word.html
http://www.msofficeforums.com/word-vba/22857-acronym-finder.html
http://www.msofficeforums.com/word/15841-there-way-derive-abbreviation-their-full-words.html#post44875

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Thanks Paul.

I really appreciate the reply. I will check out the links.

Regards,

Jim

Reply | Quote

Also check out Paul Beverley’s set of editing macros: http://www.archivepub.co.uk/book.html

He includes several to deal with acronyms.

Reply | Quote

Thanks Jweissmn1,

I appreciate the link to the macros from Paul Beverly.
I will certainly check it out as well.

Regards,

Jim

Reply | Quote

Hello again,

Here is some additional clarification on what the macro needs to do:

1. Search through a 300 page MS Word document.
2. Find all letters not numbers in parenthesis from say 2 – 10 characters in length.
3. Take the number of words preceding the parenthesis that correspond to the number of letters inside the parenthesis.
4. Output a list with the letters in parenthesis first (without the parenthesis now) followed by, for example, two spaces and then the words that had originally come before the parenthesis.

In other words, the macro finds the first word/term combination: Chief Executive Officer (CEO)

The macros sees three letters in parenthesis and three words before the parenthesis.

The macro outputs the following to a list:

CEO Chief Executive Officer

The macro loops through and finds the second word/term combination: Vice President (VP).
We see two letters now in parenthesis and two words before the parenthesis.

The macro outputs the following to the same running list:

VP Vice President

The macro loops through the document until all terms in parenthesis (for example 1-10 letters which correspond to 1-10 words) are captured and outputted
in the desired format with term first followed by term definition.

Note: The document is currently setup with acronym definition first followed by the acronym term in parenthesis – e.g. Director of Operations (DO). In this case here, I would like to filter out words like: a, of and others and just stick to just the term and acronym term acronym definition – if possible.

Please let me know if a macro like this is possible, as well as ideas on how one would make this work.

Thanks in advance for your input.

Regards,

Jim

Reply | Quote

If you look at the attachment to the last link I posted in my previous reply, you’ll see that acronyms often do not have a direct match with the expressions they abbreviate, either as to the letters that the preceding words begin with or their capitalisation. All of these are common acronyms – and can include numbers when the corresponding text doesn’t. While it would be possible to write a macro to do as you specify, you’re liable to end up with a rather incomplete list.

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Understand Paul and thanks for the reply. I think I would take whatever macro I could get and run it anyway, as it will give me something that I can use (even if partial).

Reply | Quote

Try the following macro. It should give you a list of all acronyms and the page they were found on, as a three-column table at the end of the document. Acronyms are listed in the order found, even where a matching expression couldn’t be found.

Code:

Sub AcronymLister()
Application.ScreenUpdating = False
Dim StrTmp As String, StrAcronyms As String, i As Long, Rng As Range, Tbl As Table
StrAcronyms = "Expression" & vbTab & "Acronym" & vbTab & "Page" & vbCr
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = True
    .Wrap = wdFindStop
    .Text = "(*)"
    .Replacement.Text = ""
    .Execute
  End With
  Do While .Find.Found = True
    StrTmp = Replace(Replace(.Text, "(", ""), ")", "")
    If InStr(1, StrAcronyms, .Text, vbBinaryCompare) = 0 Then
      If .Words.First.Previous.Previous.Words(1).Characters.First = Right(StrTmp, 1) Then
        For i = Len(StrTmp) To 1 Step -1
          .MoveStartUntil Mid(StrTmp, i, 1), wdBackward
          .Start = .Start - 1
          If InStr(.Text, vbCr) > 0 Then
            .MoveStartUntil vbCr, wdForward
            .Start = .Start + 1
          End If
          If .Characters.Last.Information(wdWithInTable) = False Then
            If .Characters.First.Information(wdWithInTable) = True Then
              .Start = .Cells(.Cells.Count).Range.End + 1
            End If
          ElseIf .Cells.Count > 1 Then
            .Start = .Cells(.Cells.Count).Range.Start
          End If
        Next
      End If
      StrAcronyms = StrAcronyms & .Text & vbTab & .Information(wdActiveEndAdjustedPageNumber) & vbCr
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  StrAcronyms = Replace(Replace(Replace(StrAcronyms, " (", "("), "(", vbTab), ")", "")
  Set Rng = .Characters.Last
  With Rng
    If .Characters.First.Previous  vbCr Then .InsertAfter vbCr
    .InsertAfter Chr(12)
    .Collapse wdCollapseEnd
    .Text = StrAcronyms
    Set Tbl = .ConvertToTable(Separator:=vbTab, NumRows:=.Paragraphs.Count, NumColumns:=3)
    With Tbl
      .Columns.AutoFit
      .Rows(1).HeadingFormat = True
      .Rows(1).Range.Style = "Strong"
      .Rows.Alignment = wdAlignRowCenter
    End With
  End With
End With
Set Rng = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote