Acronym finder

maceslin · #1 06-13-2019, 03:51 AM

I review long documents with thousands of acronyms and need to create a list of all the acronyms. I found this code on another site but am unable to run it against a small Word doc I get "Compile error User-defined type not defined" Not sure what I need to change

Code:

 
Sub Acronyms()
    Dim dict, k, tmp
    Dim regExp, Match, Matches
    Dim rngRange As Range
    Set regEX = New regExp
    Set dict = CreateObject("scripting.dictionary")
    regEX.Pattern = "[A-Z]{2,}" '2 or more upper-case letters
    regEX.IgnoreCase = False
    regEX.Global = True
    Set Matches = regEX.Execute(ActiveDocument.Range.Text)
    For Each Match In Matches
        tmp = Match.Value
        If Not dict.Exists(tmp) Then dict.Add tmp, 0
        dict(tmp) = dict(tmp) + 1
    Next
    For Each k In dict.Keys
        Debug.Print k, dict(k)
    Next k
End Sub

Thanks in advance for your help, I am very new to VBA

Dave

gmayor · #2 06-13-2019, 04:01 AM

It doesn't work because the syntax is wrong. e.g. you have declared regExp but called regEX. The following version should work

Code:

Sub Acronyms()
Dim dict, k, tmp
Dim regExp, Match, Matches
Dim rngRange As Range
    Set regExp = CreateObject("vbscript.regexp")
    Set dict = CreateObject("scripting.dictionary")
    regExp.Pattern = "[A-Z]{2,}"    '2 or more upper-case letters
    regExp.IgnoreCase = False
    regExp.Global = True
    Set Matches = regExp.Execute(ActiveDocument.Range.Text)
    For Each Match In Matches
        tmp = Match.value
        If Not dict.Exists(tmp) Then dict.Add tmp, 0
        dict(tmp) = dict(tmp) + 1
    Next
    For Each k In dict.Keys
Debug.Print k, dict(k)
    Next k
End Sub

maceslin · #3 06-13-2019, 04:10 AM

Works great, get expected results now I need to take it one step further.

How do I write the results to a Word file in alphabetical order?

gmayor · #4 06-13-2019, 04:23 AM

Instead of writing to the immediate window, write to a new document e.g.

Code:

Sub Acronyms()
Dim dict, k, tmp
Dim regExp, Match, Matches
Dim oDoc As Document
    Set regExp = CreateObject("vbscript.regexp")
    Set dict = CreateObject("scripting.dictionary")
    regExp.Pattern = "[A-Z]{2,}"    '2 or more upper-case letters
    regExp.IgnoreCase = False
    regExp.Global = True
    Set Matches = regExp.Execute(ActiveDocument.Range.Text)
    For Each Match In Matches
        tmp = Match.value
        If Not dict.Exists(tmp) Then dict.Add tmp, 0
        dict(tmp) = dict(tmp) + 1
    Next
    Set oDoc = Documents.Add
    For Each k In dict.Keys
        'Debug.Print k, dict(k)
        oDoc.Range.InsertAfter k & ", " & dict(k) & vbCr
    Next k
    oDoc.Range.Paragraphs.Last.Range.Delete
    oDoc.Range.Sort
End Sub

maceslin · #5 06-13-2019, 10:10 AM

I have modified the code slightly as I realized it was not drawing in acronyms that contained a number and am getting an error on the Set Matches line that state "application-defined or object define error. I suspect it is because I am no longer searching for just text. What is the member of range that include both text and numbers? Nothing jumps out at me

Code:

 
Sub Acronyms()
Dim dict, k, tmp
Dim regExp, Match, Matches
Dim oDoc As Document
    Set regExp = CreateObject("vbscript.regexp")
    Set dict = CreateObject("scripting.dictionary")
    regExp.Pattern = "\([A-Z][A-Za-z0-9]@\" '2 or more upper case letters/numbers
    regExp.IgnoreCase = False
    regExp.Global = True
    Set Matches = regExp.Execute(ActiveDocument.Range.Text)
    For Each Match In Matches
        tmp = Match.Value
        If Not dict.Exists(tmp) Then dict.Add tmp, 0
        dict(tmp) = dict(tmp) + 1
    Next
    Set oDoc = Documents.Add
    For Each k In dict.Keys
        'Debug.Print k, dict(k)
        oDoc.Range.InsertAfter k & ", " & dict(k) & vbCr
    Next k
    oDoc.Range.Paragraphs.Last.Range.Delete
    oDoc.Range.Sort
End Sub

macropod · #6 06-13-2019, 04:56 PM

See: https://www.msofficeforums.com/word-...generator.html

maceslin · #7 06-14-2019, 09:03 AM

WOW- I can not even begin to understand what all this code means but it does what I need and will use almost daily
Thanks
Dave

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Acronym Finder Macro for Microsoft Word	mars1886	Word VBA	15	03-30-2022 06:56 AM
Synonym Finder	subrota	Word VBA	3	04-29-2019 12:13 AM
Using a product key finder to transfer MS from PC to Mac - risky?	loza890	Office	1	11-02-2014 10:43 PM
Acronym Finder	Cray_Z	Word VBA	14	09-22-2014 11:42 PM
Function Finder	Kevin18014	Excel	3	01-02-2012 04:47 PM