#1
|
|||
|
|||
Acronym finder
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 Dave |
#2
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
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? |
#4
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
|||
|
|||
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 |
#6
|
||||
|
||||
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
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 |
Thread Tools | |
Display Modes | |
|
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 |