Ultra Smart Parens Plus All Caps Acronym and Meaning Extraction

[ChrisOK]

Need to find all instances of parentheses within a Word doc that have 2 or more characters within the parens.
"but wait - there's more!"
Need to make sure it doesn't pick up a sentence within parens, I'm hoping there's a way to enforce that at least 2 of the characters are in ALL CAPS consecutively)
If we say: just make sure there are at least 2 All Caps it could still pick up something like: (Computer Equipment) (not good)

Ultimately, I'm trying to extract all Acronyms (AND THEIR MEANINGS) from a Word doc.
I've found many posts that extract full all caps words - but don't want that...
Need the parens finder in place to narrow it down to hopefully just the acronyms and not other words in all caps and not other words in parens like "Computer Equipment".

The documents I'm working with are very strict in having the meaning of the acronym placed PRIOR to the acronym so my thought is -- if we can extract the full sentence preceding the parens that holds at least 2 consecutive all caps -- then, we'll be able to capture the meanings!
(Yes, probably a bit of other garb too) -- but I'm probably living a pipe dream if I think the VBA code can evaluate the acronym and then pull the "x" number of words preceding it that correspond... Hopefully, someone can tell me it's not a pipe dream at'all!?

Example:
*Course of Action (COA) - would pick up 3 preceding words since the acronym has 3 chars
*Total Case Incidence Rate (TCIR) - would pick up 4 preceding words since the acronym has 4 chars
*Accountable Property System of Record (APSR) - this is where it gets tricky (see the next one too)
*Service Development and Delivery Process (SDDP) - would pick up 5 preceding words because it sensed that it needed 5 words that started with a capital letter...so when it encountered the word "and" - it kept going left until it knew it had extracted 5 words that started with a capital letter (and) how ever many in between words as necessary..

Keep in mind, sometimes the acronyms might contain a NON-ALL CAP letter or a special character)
*Packaging, Transportation, and Regulated Material (PT&RM)
*Department of Defense (DoD)

If it's smart enough to accomplish that -- then I'll be doin' a major happy dance...
How ever close we can get -- would be greatly appreciated...
If it's just picking up a full sentence where ALL CAPS within PARENS exist together -- that's great...

Oh! The results can be placed into another new empty Word doc - or into an Excel file, whatever is easiest..
The code can assume the active Word doc is open when "Run" is clicked..

 

[Peter_SSs]

Chris, interesting problem. Not sure if I'll be able to help. I'm not a Word vba coder of any note at all. If I am able to help it would be through Excel.
Is it possible the the Word document contents could be pasted into Excel? From my point of view, what that looked like wouldn't matter much so long as an acronym and its preceding meaning was not split over multiple cells. (It wouldn't matter if more then one acronym & meanings appeared in a single cell though.)

In any case I have some clarification questions to get a better feel for exactly what would be needed.

1.

*Service Development and Delivery Process (SDDP) - would pick up 5 preceding words because it sensed that it needed 5 words that started with a capital letter.

If it was able to sense that, why wouldn't it sense that (COA) from your first example needed 3 words that started with a capital letter not just 2?

2. From your examples it seems that we could distinguish an acronym in parentheses from a sentence in parentheses simply by the lack of space characters in the acronyms rather than bothering about counting upper case letters. Is that correct? If not, some examples that demonstrate please.

3. I presume that an * represents other preceding text. Could we have a few dummy examples that included that preceding text as well as the acronym definition & abbreviation? And if more than one definition & acronym can occur in a single sentence/paragraph, could we have a few of those too?

 

[Macropod]

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.

The macro uses the ‘ParseNumSeq’ function to concatenate consecutive page ranges.

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]{2,}\)"
      .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
    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
      .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
  End With
  Rng.Start = ActiveDocument.Range.Start
  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
        If Not .InRange(Rng) Then Exit Do
        j = j + 1
        If k <> .Duplicate.Information(wdActiveEndAdjustedPageNumber) Then
          k = .Duplicate.Information(wdActiveEndAdjustedPageNumber)
          StrTmp = StrTmp & k & " "
        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

 

[Peter_SSs]

I'm hoping there's a way to enforce that at least 2 of the characters are in ALL CAPS consecutively

Note that this would exclude "DoD" which is in your list of example acronyms.

If you want to work in Word, then by all means follow through with Paul, but I was interested in the problem and have made an attempt in Excel.
As you see below, I have copied your samples from your post and pasted directly into Excel as my test data.

I made the following assumption to identify acronyms: Text in parentheses with no spaces and must (at least) begin and end with an upper case letter (This no longer excludes "DoD")

Test data in column A of a worksheet (the active sheet):

[TABLE="class: grid, width: 938"]
[TR]
[TD]*Course of Action (COA) - would pick up 3 preceding words since the acronym has 3 chars[/TD]
[/TR]
[TR]
[TD]*Total Case Incidence Rate (TCIR) - would pick up 4 preceding words since the acronym has 4 chars[/TD]
[/TR]
[TR]
[TD]*Accountable Property System of Record (APSR) - this is where it gets tricky (see the next one too)[/TD]
[/TR]
[TR]
[TD]*Service Development and Delivery Process (SDDP) - would pick up 5 preceding words because it sensed that it needed 5 words that started with a capital letter...so when it encountered the word "and" - it kept going left until it knew it had extracted 5 words that started with a capital letter (and) how ever many in between words as necessary..[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]Keep in mind, sometimes the acronyms might contain a NON-ALL CAP letter or a special character)[/TD]
[/TR]
[TR]
[TD]*Packaging, Transportation, and Regulated Material (PT&RM)[/TD]
[/TR]
[TR]
[TD]*Department of Defense (DoD)[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]If it's smart enough to accomplish that -- then I'll be doin' a major happy dance...[/TD]
[/TR]
[TR]
[TD]How ever close we can get -- would be greatly appreciated...[/TD]
[/TR]
[TR]
[TD]If it's just picking up a full sentence where ALL CAPS within PARENS exist together -- that's great...[/TD]
[/TR]
[/TABLE]

Sub GetAcronyms()
  Dim RX As Object, Mtchs As Object
  Dim a As Variant, b As Variant, itm As Variant, bits As Variant
  Dim s As String, acr As String, e As String
  Dim i As Long, j As Long, r As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.MultiLine = True
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Rows.Count, 1 To 2)
  For i = 1 To UBound(a)
    s = a(i, 1)
    RX.Pattern = "(\()([A-Z][^ ]*[A-Z])(\))"
    If RX.test(s) Then
      Set Mtchs = RX.Execute(s)
      For Each itm In Mtchs
        r = r + 1
        acr = itm.submatches(1)
        e = Replace(acr, "&", "A")
        b(r, 1) = acr
        bits = Split(Trim(Replace(StrConv(e, vbUnicode), ChrW(0), " ")))
        bits(0) = bits(0) & ".+?"
        For j = 1 To UBound(bits) - 1
          bits(j) = "(" & bits(j) & "|" & LCase(bits(j)) & ").+?"
        Next j
        bits(UBound(bits)) = bits(UBound(bits)) & "\w+?"
        RX.Pattern = Join(bits) & " *?\(" & acr & "\)"
        If RX.test(s) Then
          b(r, 2) = Trim(Replace(RX.Execute(s)(0), itm, ""))
        Else
          For j = 1 To UBound(bits)
            bits(j) = "(\b.+\b )*?" & bits(j)
          Next j
          RX.Pattern = Join(bits) & " *?\(" & e & "\)"
          If RX.test(s) Then
            b(r, 2) = Trim(Replace(RX.Execute(s)(0), itm, ""))
          End If
        End If
      Next itm
    End If
  Next i
  If r > 0 Then
    Sheets.Add After:=ActiveSheet
    With Range("A1:B1")
      .Value = Array("Acronym", "Meaning")
      .Offset(1).Resize(r).Value = b
      .EntireColumn.AutoFit
    End With
  End If
End Sub

Results of the code in a new worksheet in the same workbook:
[TABLE="class: grid, width: 330"]
[TR]
[TD]Acronym[/TD]
[TD]Meaning[/TD]
[/TR]
[TR]
[TD]COA[/TD]
[TD]Course of Action[/TD]
[/TR]
[TR]
[TD]TCIR[/TD]
[TD]Total Case Incidence Rate[/TD]
[/TR]
[TR]
[TD]APSR[/TD]
[TD]Accountable Property System of Record[/TD]
[/TR]
[TR]
[TD]SDDP[/TD]
[TD]Service Development and Delivery Process[/TD]
[/TR]
[TR]
[TD]PT&RM[/TD]
[TD]Packaging, Transportation, and Regulated Material[/TD]
[/TR]
[TR]
[TD]DoD[/TD]
[TD]Department of Defense[/TD]
[/TR]
[/TABLE]

If my code finds an acronym but is unable to identify the meaning, it will record the acronym in the final table but leave the 'Meaning' column blank.

 

[ChrisOK]

Ok- first of all - both of you are amazing with what you've come up with --
Truly appreciate the variation of achieving the same goals using totally different methods --

About to drop into bed, but I couldn't help but run a quick test with each to see the outcome - or else I know I would never sleep!

PETER:
I may have mis-typed with the orig count on (COA) and (SDDP) (I guess the difference is, that COA actually puts an "O" in the acronym as a placeholder for the lowercase word "of" --
--but the SDDP does not -- it just sneaks those extra words in like "and" in that case -- (those words are not visible within the acronym itself)
- but I think you figured out what I meant by looking at the actual acronym examples I had provided.. and the number of words that would logically be extracted based on the number of letters in the acronym (with a few exceptions when a word like "of" was sandwiched in between some all caps words)..

I'm not sure I understand your question #2.. hopefully, the above just answered that..?

The * was just my way of making bullet points (sorry, was not refrcg' wild cards or preceding text)

I placed the code within Word (while the source doc was open) and tried to run it but got:
"Compile error: Sub or Function not defined"
The 2nd occurrence of the word "Range" was highlighted within the 9th row of code:
a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value

Then I re-read and saw you tested it within Excel, pasted it into an Excel module and got Run time error 13: type mismatch... re-read again and saw you'd pasted all the acronyms into an Excel sheet as well -- so that's probably my issue (as the content is within a 56 page Word document that's not in strictly tables -- much is from verbiage content of that Word doc)

Maybe I've done something wrong? let me know and I'll re-test in the morning..

PAUL:
I placed yours within a Word module (while the orig Word doc was still open and ready for extraction).
I wasn't sure if it was going to place the results in a new file or what -- but found that it placed it near the end of the source doc.. (it split the last paragraph in half and shoved it down to the end -- but not a big deal -- I can easily put it back up where it belongs and extract out that table.

It looks pretty amazing -- 6 pages of acronyms and their preceding "Terms"/aka meanings).
*There's some acronyms that don't have their Term/meaning as you mentioned might occur --
*There's some acronyms that captured 1 word from the Term but not the other 2..not sure why yet? -- I'll navigate to the location referenced and check out what might have caused it after I get some sleep tonight..
This particular acronym was "PWS" Performance Work Statement... the code picked up just the word: "Statement"...?
However, I do see that several rows down, it picked up PWS and the full term "Performance Work Statement" -- so not sure what caused one to work and one to fail..?

Another was (ADAS) "Associate Assistant Deputy Secretary" yet it only picked up "Secretary".
I navigated to that page and found that this (below) was the problem...

...sfll jljk jlf part of content here sljfeo jfs jfs jlkjlj Associate Deputy Assistant
Secretary (ADAS) sfkljer but the rest was on a new line
(yes, the code did what it was supposed to... stuck to it's line)

(The rest of the acronym was on the previous line of text within the doc) -- BLAAH!
Wouldn't you know it!?! It out-witted us! I didn't "plan" for that scenario...
Maybe instead of saying the rule is:
"Pick up the preceding words on the same line of text"
do
"Pick up the preceding words within the same SENTENCE"
-- this way, if the sentence is split like the above scenario --- we're covered...

I was especially anxious to see if it could pull in a full Term when the acronym had extra words like "of" or "and" mixed in and it did!! WOO HOO!
"NIST" extracted "National Institute of Standards and Technology"
Double WOO HOO (it snatched both the "of" and the "and")
Happy Dancing before bed about now...

I'll investigate the other issues further in the morning and will provide an update -

 

[Peter_SSs]

I'm not sure I understand your question #2..

You said that you didn't want to pick up a sentence in parentheses as an acronym nor did you want something like "Computer Equipment"

Per post #4 I used the rule that an acronym must have no spaces and must start & finish with a capital letter.
(A whole sentence like this is ruled out because it both contains spaces and does not end with a capital letter)
(Computer Equipment) is ruled out because it both contains spaces and does not end with a capital letter
(Computer) is ruled out as it does not end with a capital letter
etc

My code will definitely not run in Word.

pasted it into an Excel module and got Run time error 13: type mismatch

When reporting such errors it is always helpful if you identify what line of code the error occurs on.

re-read again and saw you'd pasted all the acronyms into an Excel sheet as well

No, I didn't do that, the code did that. That's the point of the code isn't it?

 

[Peter_SSs]

OK, I've had a try in Word instead of Excel.

Disclaimer (again): I'm a novice at Word vba so apologies if some of this is poorly written (& I'm happy to receive constructive criticism).

This code would go in a standard module in the Word document that is to be searched.
It should put the table of acronyms starting on a new page at the end of the document.
I don't know if you have repeated acronyms and, if so, what you want to do about that. For the moment at least, my code should list any repeats on a separate row in the final table.

Anyway, give it a whirl & see what happens.

Sub GetAcronyms()
  Dim p As Paragraph
  Dim s As String, acr As String, e As String
  Dim j As Long, r As Long
  Dim Results As Variant, itm As Variant, bits As Variant
  Dim RX As Object, Mtchs As Object
  Dim tbl As Table
  
  ReDim Results(1 To 10000, 1 To 2)
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.MultiLine = True

  For Each p In ThisDocument.Paragraphs
    s = p.Range.Text
    RX.Pattern = "(\()([A-Z][^ ]*[A-Z])(\))"
    If RX.test(s) Then
      Set Mtchs = RX.Execute(s)
      For Each itm In Mtchs
        r = r + 1
        acr = itm.submatches(1)
        Results(r, 1) = acr
        e = Replace(acr, "&", "A")
        bits = Split(Trim(Replace(StrConv(e, vbUnicode), ChrW(0), " ")))
        bits(0) = "\b" & bits(0) & ".+?"
        For j = 1 To UBound(bits) - 1
          bits(j) = "(\b.+?\b )?(" & bits(j) & "|" & LCase(bits(j)) & ").+?"
        Next j
        bits(UBound(bits)) = "(\b.+?\b )?" & bits(UBound(bits)) & "\w+?"
        RX.Pattern = Join(bits) & " *?\(" & acr & "\)"
        If RX.test(s) Then
          Results(r, 2) = Trim(Replace(RX.Execute(s)(0), itm, ""))
        End If
        s = Mid(s, InStr(1, s, itm) + Len(itm))
      Next itm
    End If
  Next p
  
  With Selection
    .EndKey Unit:=wdStory
    .InsertBreak Type:=wdPageBreak
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=r + 1, NumColumns:=2, AutoFitBehavior:=wdAutoFitFixed
    Set tbl = ActiveDocument.Tables(ActiveDocument.Tables.Count)
    tbl.Cell(1, 1).Range.Text = "Acronym"
    tbl.Cell(1, 2).Range.Text = "Meaning"
    For j = 1 To r
      tbl.Cell(j + 1, 1).Range.Text = Results(j, 1)
      tbl.Cell(j + 1, 2).Range.Text = Results(j, 2)
    Next j
    tbl.AutoFitBehavior (wdAutoFitContent)
  End With
End Sub

 

[Macropod]

*There's some acronyms that captured 1 word from the Term but not the other 2..not sure why yet? -- I'll navigate to the location referenced and check out what might have caused it after I get some sleep tonight..
This particular acronym was "PWS" Performance Work Statement... the code picked up just the word: "Statement"...?
However, I do see that several rows down, it picked up PWS and the full term "Performance Work Statement" -- so not sure what caused one to work and one to fail..?

Most likely there is some inconsistency in the way the first term is expressed.

Another was (ADAS) "Associate Assistant Deputy Secretary" yet it only picked up "Secretary".
I navigated to that page and found that this (below) was the problem...

...sfll jljk jlf part of content here sljfeo jfs jfs jlkjlj Associate Deputy Assistant
Secretary (ADAS) sfkljer but the rest was on a new line
(yes, the code did what it was supposed to... stuck to it's line)

(The rest of the acronym was on the previous line of text within the doc) -- BLAAH!
Wouldn't you know it!?! It out-witted us! I didn't "plan" for that scenario...

The issue here has nothing to do with line wrapping but with the fact ADAS is not an acronym for "Associate Assistant Deputy Secretary" - it's an acronym for "Associate Deputy Assistant Secretary".

Maybe instead of saying the rule is:
"Pick up the preceding words on the same line of text"
do
"Pick up the preceding words within the same SENTENCE"
-- this way, if the sentence is split like the above scenario --- we're covered...

But, there is no "Pick up the preceding words on the same line of text" rule. If you read my post, you'll see the rule is already "Pick up the preceding words within the same SENTENCE" ...

 

[ChrisOK]

PETER, thanks again for the effort -- and totally understand the novice disclaimer =-) I pasted the latest code into a module of the word document - hit run - and it indeed went to the end of the document on a nice new page and placed a header row: "Acronymn" "Meaning" -- however, no results were within the table it created.

To answer your question about repeats --
Yes, it's a large contract and throughout it -- terms are repeated --but that wasn't a problem, I simply pasted the results into an excel file, eliminated the duplicates, CTRL G to look up issues that didn't feed the full term in -- manually backfilled those -- and all was good using the other code Paul provided.
It look a little manual effort but yet still saved an ENORMOUS amount of time --- So -- unless you are driven to keep dabbling with it -- I would not worry about it -- I've got something that gets the extraction done and I hate to waste any of your time...
If you do post something new, I'll certainly check it out and see if it works better -- but I think I'm good for now -- thanks so much!!

PAUL: UPDATE:
I turned on OPTIONS > DISPLAY "show all formatting marks" and found that the reason your code wasn't able to pick up some of the full terms (and was feeding some partials) was because there were "P" (paragraph) breaks that were separating the sentence - so it was an issue with contract - don't believe it had anything to do with your code.. =-)

BTW - I LOVE the extra table columns that told me what page to go locate the refc' -- it made locating problems much less painful.
*Can you tell me what the "Cross Refc Count" is?
I thought it might be the count/number of times of an acronym in parens occurrence but the 2 I checked does not add up --
(one says "1" but the acronym is found 7 times with Ctrl+F (3 of the 7 were in parens) and had no "P" (paragraph separation)
(one says "7" but acronym is found 23 times with Ctrl+F (8 of the 23 were in parens)
I originally assumed it might be counting only parens hits) but both were off... so I'm thinking you might have some other intent for it?

The important thing is that it was able to generate a nice big list -- so I'm not sweating it --- I just thought I'd ask so I understood it fully... Thank you again -

THANK YOU BOTH AGAIN!! So very much appreciated!

 

[Macropod]

I turned on OPTIONS > DISPLAY "show all formatting marks" and found that the reason your code wasn't able to pick up some of the full terms (and was feeding some partials) was because there were "P" (paragraph) breaks that were separating the sentence - so it was an issue with contract - don't believe it had anything to do with your code.. =-)

That's to be expected - sentences don't cross paragraph breaks.

*Can you tell me what the "Cross Refc Count" is?
I thought it might be the count/number of times of an acronym in parens occurrence but the 2 I checked does not add up --

If you're seeing "Cross Refc Count", that suggests something has gone awry with your copying & pasting of the code - it should read "Cross-Reference Count", which is the number of time the acronym appears in the document after the initial entry. What it won't tell you is the number of times you have the full-text elsewhere in the document instead of, or in conjunction with, the acronym. To address that issue, you could run the following macro, after editing any entries in the acronym table that didn't come out correctly:

Sub AcronymManager()
Application.ScreenUpdating = False
Dim Rng As Range, Tbl As Table, r As Long, StrExp As String, StrAcc As String
With ActiveDocument
  Set Rng = .Range: Set Tbl = .Tables(.Tables.Count)
  Rng.End = Tbl.Range.Start
  For r = 2 To Tbl.Rows.Count
    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
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

What this macro will do is 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 original macro and re-run that macro, you'd possibly get a different result - depending on how many erroneous entries there were in the unedited document.