Acronym and definiton list generator

Ulodesk · #1 04-20-2019, 09:07 AM

I have a 2006 "Acronym List Generator and Maintainer RevE" that I picked up along the way years ago. It's a .doc with a button inside that activates the macro. It extracts acronyms and their definitions from a target Word doc and appears to work fine in desktop Word 365. It steps through found acronyms and their definitions one by one, allowing alterations, and creates a 2-column table in a new doc.

I just wonder if anyone knows of an updated free (or very inexpensive, not the $85-and-up commercial programs) such utility that does not require stepping through each one but compiles all into a table, leaving it to the user to review the selections in the new table. In very long technical documents with lots of acronyms, this could be a significant time saver.

All I find in searches is acronym finders, either the wildcard find version for 2 or more adjacent caps, but the definitions then need to be supplied.

macropod · #2 04-20-2019, 03:20 PM

The following macro checks the contents of a document for upper-case/numeric parenthetic abbreviations it then looks backwards to try to determine what term they abbreviate. For example:
World Wide Web (WWW)
Naturally, given the range of acronyms in use, it’s not foolproof and, if a match isn’t made, the preceding sentence (in VBA terms) is captured so the user can edit the output. A table is then built at the end of the document, which is then searched for all references to the acronym (other than for the definition) and the counts and page numbers added to the table.

Code:

Sub AcronymLister()
Application.ScreenUpdating = False
Dim StrTmp As String, StrAcronyms As String, i As Long, j As Long, k As Long, Rng As Range, Tbl As Table
StrAcronyms = "Acronym" & vbTab & "Term" & vbTab & "Page" & vbTab & "Cross-Reference Count" & vbTab & "Cross-Reference Pages" & vbCr
With ActiveDocument
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWildcards = True
      .Wrap = wdFindStop
      .Text = "\([A-Z0-9][A-Z&0-9]{1" & Application.International(wdListSeparator) & "}\)"
      .Replacement.Text = ""
      .Execute
    End With
    Do While .Find.Found = True
      StrTmp = Replace(Replace(.Text, "(", ""), ")", "")
      If (InStr(1, StrAcronyms, .Text, vbBinaryCompare) = 0) And (Not IsNumeric(StrTmp)) 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 .Sentences.Count > 1 Then .Start = .Sentences.Last.Start
            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
        StrTmp = Replace(Replace(Replace(.Text, " (", "("), "(", "|"), ")", "")
        StrAcronyms = StrAcronyms & Split(StrTmp, "|")(1) & vbTab & Split(StrTmp, "|")(0) & vbTab & .Information(wdActiveEndAdjustedPageNumber) & vbTab & vbTab & vbCr
      End If
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
  StrAcronyms = Replace(Replace(Replace(StrAcronyms, " (", "("), "(", vbTab), ")", "")
  Set Rng = ActiveDocument.Range.Characters.Last
  With Rng
    If .Characters.First.Previous <> vbCr Then .InsertAfter vbCr
    .InsertAfter Chr(12)
    .Collapse wdCollapseEnd
    .Style = "Normal"
    .Text = StrAcronyms
    Set Tbl = .ConvertToTable(Separator:=vbTab, NumRows:=.Paragraphs.Count, NumColumns:=5)
    With Tbl
      .Columns.AutoFit
      .Rows(1).HeadingFormat = True
      .Rows(1).Range.Style = "Strong"
      .Rows.Alignment = wdAlignRowCenter
    End With
    .Collapse wdCollapseStart
  End With
  For i = 2 To Tbl.Rows.Count
    StrTmp = "": j = 0: k = 0
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Forward = True
        .Text = Split(Tbl.Cell(i, 1).Range.Text, vbCr)(0)
        .MatchWildcards = True
        .Execute
      End With
      Do While .Find.Found = True
        If .InRange(Tbl.Range) Then Exit Do
        j = j + 1
        If j > 0 Then
          If k <> .Duplicate.Information(wdActiveEndAdjustedPageNumber) Then
            k = .Duplicate.Information(wdActiveEndAdjustedPageNumber)
            StrTmp = StrTmp & k & " "
          End If
        End If
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
    Tbl.Cell(i, 4).Range.Text = j
    StrTmp = Replace(Trim(StrTmp), " ", ",")
    If StrTmp <> "" Then
      'Add the current record to the output list (StrOut)
      StrTmp = Replace(Replace(ParseNumSeq(StrTmp, "&"), ",", ", "), "  ", " ")
    End If
    Tbl.Cell(i, 5).Range.Text = StrTmp
  Next
End With
Set Rng = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub

Function ParseNumSeq(StrNums As String, Optional StrEnd As String)
'This function converts multiple sequences of 3 or more consecutive numbers in a
' list to a string consisting of the first & last numbers separated by a hyphen.
' The separator for the last sequence can be set via the StrEnd variable.
Dim ArrTmp(), i As Long, j As Long, k As Long
ReDim ArrTmp(UBound(Split(StrNums, ",")))
For i = 0 To UBound(Split(StrNums, ","))
  ArrTmp(i) = Split(StrNums, ",")(i)
Next
For i = 0 To UBound(ArrTmp) - 1
  If IsNumeric(ArrTmp(i)) Then
    k = 2
    For j = i + 2 To UBound(ArrTmp)
      If CInt(ArrTmp(i) + k) <> CInt(ArrTmp(j)) Then Exit For
      ArrTmp(j - 1) = ""
      k = k + 1
    Next
    i = j - 2
  End If
Next
StrNums = Join(ArrTmp, ",")
StrNums = Replace(Replace(Replace(StrNums, ",,", " "), ", ", " "), " ,", " ")
While InStr(StrNums, "  ")
  StrNums = Replace(StrNums, "  ", " ")
Wend
StrNums = Replace(Replace(StrNums, " ", "-"), ",", ", ")
If StrEnd <> "" Then
  i = InStrRev(StrNums, ",")
  If i > 0 Then
    StrNums = Left(StrNums, i - 1) & Replace(StrNums, ",", " " & Trim(StrEnd), i)
  End If
End If
ParseNumSeq = StrNums
End Function

Do note that, if you have any parenthetic uppercase single words, those will also be included in the output.

The following macro uses the table generated by the macro above to ensure each reference is listed in full, with its acronym, the first time it occurs in the document (e.g. Automated Teller Machine (ATM)) and thereafter as just the acronym (i.e. ATM). If you were to then delete the table produced by the macro above and re-run that macro, you'd possibly get a different result - depending on how many erroneous entries there were in the unedited document.

Code:

Sub AcronymManager()
Application.ScreenUpdating = False
Dim Rng As Range, Tbl As Table, j As Long, k As Long, r As Long, StrTmp As String, StrExp As String, StrAcc As String
With ActiveDocument
  Set Tbl = .Tables(.Tables.Count)
  For r = 2 To Tbl.Rows.Count
    Set Rng = .Range
    Rng.End = Tbl.Range.Start
    With Rng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = True
      .MatchCase = True
      .Forward = True
      .Wrap = wdFindStop
      StrAcc = Split(Tbl.Cell(r, 1).Range.Text, vbCr)(0)
      StrExp = Split(Tbl.Cell(r, 2).Range.Text, vbCr)(0)
      .Text = StrExp
      .Replacement.Text = StrAcc
      .Execute Replace:=wdReplaceAll
      .Text = StrAcc & "^w" & "(" & StrAcc & ")"
      .Replacement.Text = StrAcc
      .Execute Replace:=wdReplaceAll
    End With
    With Rng.Find
      .Text = StrAcc
      .Replacement.Text = StrExp & " (" & StrAcc & ")"
      .Execute Replace:=wdReplaceOne
      If .Found = True Then Tbl.Cell(r, 3).Range.Text = Rng.Information(wdActiveEndAdjustedPageNumber)
    End With
  Next
  For r = 2 To Tbl.Rows.Count
    StrTmp = "": j = 0: k = 0
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Forward = True
        .Text = Split(Tbl.Cell(r, 1).Range.Text, vbCr)(0)
        .MatchWildcards = True
        .Execute
      End With
      Do While .Find.Found = True
        If .InRange(Tbl.Range) Then Exit Do
        With Tbl.Cell(r, 3).Range
          If Split(.Text, vbCr)(0) = "" Then .Text = Rng.Information(wdActiveEndAdjustedPageNumber)
        End With
        j = j + 1
        If j > 0 Then
          If k <> .Duplicate.Information(wdActiveEndAdjustedPageNumber) Then
            k = .Duplicate.Information(wdActiveEndAdjustedPageNumber)
            StrTmp = StrTmp & k & " "
          End If
        End If
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
    Tbl.Cell(r, 4).Range.Text = j
    StrTmp = Replace(Trim(StrTmp), " ", ",")
    If StrTmp <> "" Then
      'Add the current record to the output list (StrOut)
      StrTmp = Replace(Replace(ParseNumSeq(StrTmp, "&"), ",", ", "), "  ", " ")
    End If
    Tbl.Cell(r, 5).Range.Text = StrTmp
  Next
End With
Application.ScreenUpdating = True
End Sub

I have also enhanced the second macro so that, if you want to, you can add your own acronyms & definitions to the table. When it runs, it will also update all the other columns for existing entries in case the document has undergone significant editing in the meantime.

For PC macro installation & usage instructions, see: Installing Macros
For Mac macro installation & usage instructions, see: Word:mac - Install a Macro

Ulodesk · #3 04-23-2019, 10:44 AM

Paul, I haven't had a chance to try out the macro yet, but I have no doubt it will be superb. Thank you!

It continually amazes me that we are able to get this kind of top-level asistance for free, and usually so promptly. I'ts wonderful that you, and others, offer your expertise.

rwoodvet · #4 06-19-2019, 04:55 AM

Paul,

Good morning from Virginia! I realize that this post is ten years old, but I'm hoping I can still gets some assistance with the macro you provided.

I made minor changes to suit my needs better:

1. Changed the following because we use section breaks in our documents:

Code:

wdActiveEndAdjustedPageNumber

to

Code:

wdActiveEndPageNumber

2. Commented out the follwing because it was putting the first and last columns of the table outside of the margins of the page.

Code:

.Columns.AutoFit

Issue #1:
One of the issues I'm having is that the terms are not being pulled and placed into the Term column, or it pulls the term(s) and the entire sentence it was in.

I had a thought where I could try to make it find the words that start with each letter in the acronym, and place them into the table. But some of our acronyms are more like abbreviations, so that won't work.

Issue #2:
In the line below, you have 6 pairs of double quotes, some of which surround an open or closed parenthesis, but I can't figure out what the "|" is for. What is that, and why is there 6 pairs of double quotes?

Code:

StrTmp = Replace(Replace(Replace(.Text, " (", "("), "(", "|"), ")", "")

Actually, now that I've looked at it more, there are 6 open parentheses and 4 closed parentheses on that line. Shouldn't there be equal pairs?

I'm going to try and massage it more to get it to do what I need it to, but would like to ask you more questions if you're available.

Thanks for the macro and your time!

macropod · #5 06-19-2019, 05:19 AM

Quote:

Originally Posted by rwoodvet

I realize that this post is ten years old

Methinks you need your eyes checked - it's not yet two months old...

Quote:

Originally Posted by rwoodvet

Issue #1:
One of the issues I'm having is that the terms are not being pulled and placed into the Term column, or it pulls the term(s) and the entire sentence it was in.

Please read the posted comments preceding the macro, which clearly say sentences will be pulled in some cases. If some terms are not being found at all, that suggests there's nothing preceding the abbreviations in the paragraphs concerned.

Quote:

Originally Posted by rwoodvet

Issue #2:
In the line below, you have 6 pairs of double quotes, some of which surround an open or closed parenthesis, but I can't figure out what the "|" is for. What is that, and why is there 6 pairs of double quotes?

Code:

StrTmp = Replace(Replace(Replace(.Text, " (", "("), "(", "|"), ")", "")

The code is correct as is.

rwoodvet · #6 06-19-2019, 07:50 AM

I looked at the date in the wrong corner, which is why I assume the ten year span. Forums are a whole new world to me, so I'll be careful next time.

As for my first issue, I did read the preceding comment, and I understood it. I just can't understand why the macro is pulling nothing for many of the acronyms; I'm getting blank cells.

As for my second issue, I wasn't questioning whether the code is correct. I was simply asking why the difference in pairs of parentheses and what the bar symbol meant.

But as I said before, I'm going to try to get it to work the way I need it to. So thanks.

macropod · #7 06-19-2019, 03:36 PM

If you break down:
StrTmp = Replace(Replace(Replace(.Text, " (", "("), "(", "|"), ")", "")
you'll see there are three nested Replace(expression, find, replace) functions. As each such function has its own parentheses, it is only those that need to be balanced - the ones in quotes are parts of the find/replace variables.

Jenn15c · #8 06-30-2019, 02:15 PM

Thank you for the macro, this has been very useful - is there a way to modify the macro so that the acronym list generates in a new document and is sorted alphabetically?

Best regards,
Jennifer

macropod · #9 06-30-2019, 05:11 PM

I'm not sure what the point of generating the list in a separate document would be. Nevertheless, that could be done by inserting:
Documents.Add
before:
Set Rng = ActiveDocument.Range.Characters.Last
and delete or comment-out:

Code:

    If .Characters.First.Previous <> vbCr Then .InsertAfter vbCr
    .InsertAfter Chr(12)
    .Collapse wdCollapseEnd

As for the sorting, that could be accomplished by inserting:

Code:

      .Sort ExcludeHeader:=True, FieldNumber:="Column 1", CaseSensitive:=False, _
        SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending

anywhere within the:

Code:

With Tbl
...
End With

block.

Guessed · #10 11-16-2021, 09:25 PM

Yes, the code can be adapted to output to an Excel worksheet. See this thread for a code example that could be adapted to this task.
https://www.msofficeforums.com/word-...perscript.html

To include lower case is a bit more difficult as it requires tradeoffs and decisions. It most likely requires multiple passes
This existing search string finds capitals and numbers with at least two characters
.Text = "$[A-Z0-9][A-Z&0-9]{1" & Application.International(wdListSeparator) & "}$"

To include lowercase characters you need to include multiple passes to keep out regular camel case words (eg Hello, To, iPhone) but get three+ character instances (eg BoM, MgO2). A search string for that might be
.Text = "$[A-Z0-9][a-z&][A-Z&0-9]{1" & Application.International(wdListSeparator) & "}$"

Ulodesk · #11 03-30-2022, 06:56 AM

Paul, thank you. Your macros in post #2 are not working in a document I have. I have run the first in a couple of other documents, and it fairly quickly creates the table at the end. I don't know why it's balking on this one. I have accepted all changes deleted the comments, and have nothing displayed from the track changes menu. I don't offhand see anything in the document that stands out as a potential problem, and the document is on my desktop. But running the Lister macro simply hangs the machine. After about 15 seconds, Word Not Responding comes on and the blue "working" circle churns away. I let it go for a half hour and finally used task manager to close Word.

Since it's a proposal, I can't post it. Maybe the macro will work after full DTP is complete. Unless you have ideas of what might be causing the issue.

Thank you.

macropod · #12 03-30-2022, 02:40 PM

Assuming you're having problems with the 'AcronymLister' sub:
• comment out 'Application.ScreenUpdating = False'
• insert:

Code:

.Select
Msgbox .Text

after 'Do While .Find.Found = True'
That will show you what has been matched on each iteration and should allow you to identify where in the document the code hangs.

Ulodesk · #13 03-31-2022, 06:52 AM

Hello again, and thank you. I made the changes you offered.

The document stops producing the pop-ups after about a dozen acronyms. The next such item, just a sentence or two down, is "(SAFe)". Could it be that the lower-case letter is causing the problem? Scanning the document I see other terms, such as (APIs) and (IaaS).

I am ever grateful for your continued support.

macropod · #14 03-31-2022, 02:43 PM

The code in post #2 only processes acronyms in the form of (A1B2C3) - that is finds capitals and numbers with at least two characters - and would only skip over acronyms like (SAFe). Andrew provided an adaptation in post #10 to incorporate lower-case characters.

Whichever variant you used, the code would have hung on the one that produced the last message box.

Ulodesk · #15 04-01-2022, 12:57 PM

Well, something is going awry; I have no idea what. Two of us have tried Andrew's variation to no avail; it still hangs. I can't figure out why it is hanging at a 3-cap acronym, after which the very next one is the same, with different letters. There is no parenthesis in between the two, which are even on the same page.

So, it seems that the two-pass solution, unless I have misunderstood it, is stymied in this case, because neither Paul's nor Andrew's will continue past a fairly early page, each hanging at a different point.

Let me say that we have done this by inserting Andrew's line under Paul's and commenting it out, and then tried commenting out Paul's and enabling Andrew's.

There must be something I am not getting about running these (surprise, surprise).

I'm sorry I can't send the text.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Adding List Number to Acronym Table	SerenityNetworks	Word VBA	6	12-13-2016 01:36 PM
Random Name Generator	knp11	Word	1	01-18-2015 11:41 AM
Need guidance on creating a Word doc generator	mikeman	Word VBA	1	10-26-2014 10:35 PM
Acronym Finder	Cray_Z	Word VBA	14	09-22-2014 11:42 PM
Document Generator	HJJ	Word	0	08-12-2009 03:28 AM