#1
|
|||
|
|||
Acronym Finder Macro for Microsoft Word
Hello all,
I'm new to this and just have a quick request if that's okay . I'm looking for a macro the finds acronyms in a document and puts them in a table that is already located at the bottom of the document.
I understand this may be a difficult request, but if there are any questions, comments, or concerns, I'm here! Thanks! |
#2
|
||||
|
||||
The macro below checks the contents of a document against a series of expressions in the second column of the first table in the document, and outputs a count of those matches in the third column of the table. Document contents before the table are not checked (this makes it more flexible for use in a document where you want to exclude the ‘front matter’ from checking). For your purposes, the acronyms would be stored in the second column. Only minor modifications would be needed to adapt this to use the 1st & 2nd columns instead of the 2nd & 3rd columns. Using the 2nd & 3rd columns, though, allows you to put the acronym's description in the 1st column.
Code:
Sub AcronymFinder() Application.ScreenUpdating = False Dim RngDoc As Range, oTbl As Table, i As Long, j As Long Dim strAcr As String, strFnd As String, strDef As String strAcr = "," Set RngDoc = ActiveDocument.Range With ActiveDocument Set oTbl = .Tables(1) RngDoc.Start = oTbl.Range.End For i = 2 To oTbl.Rows.Count With oTbl.Cell(i, 2).Range strFnd = Left(.Text, Len(.Text) - 2) strAcr = strAcr & strFnd & "," End With Next With RngDoc With .Find .ClearFormatting .Replacement.ClearFormatting .Format = False .Forward = True .Text = "\([A-Z][A-Za-z0-9]@\)" .MatchWildcards = True .Execute End With Do While .Find.Found .Start = .Start + 1 .End = .End - 1 strFnd = .Text If InStr(strAcr, "," & strFnd & ",") = 0 Then strAcr = strAcr & strFnd & "," strDef = Trim(InputBox("New Term Found: " & strFnd & vbCr & _ "Add to definitions?" & vbCr & _ "If yes, type the definition.")) If strDef <> vbNullString Then With oTbl.Rows .Add .Last.Cells(1).Range.Text = strDef .Last.Cells(2).Range.Text = strFnd End With End If End If .Collapse wdCollapseEnd .Find.Execute Loop End With For i = oTbl.Rows.Count To 2 Step -1 With oTbl.Cell(i, 2).Range strFnd = Left(.Text, Len(.Text) - 2) End With Set RngDoc = ActiveDocument.Range With RngDoc With .Find .ClearFormatting .Replacement.ClearFormatting .Format = False .Forward = True .Text = strFnd .MatchWholeWord = True .MatchWildcards = False .MatchCase = True .Execute End With j = 0 Do While .Find.Found j = j + 1 .Collapse wdCollapseEnd .Find.Execute Loop End With If j < 2 Then oTbl.Rows(i).Delete Else oTbl.Cell(i, 3).Range.Text = j - 1 End If Next End With Set RngDoc = Nothing: Set oTbl = Nothing Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
thanks very much!
|
#4
|
|||
|
|||
Hello,
I am working on a similar project and i am not able to adapt your code. Indeed, i modified the code to store the data in another table but i am not able to search for acronyms without parentheses. I tried using "[A-Z]{2,}" instead of "\([A-Z][A-Za-z0-9]@\)" but it is not working. My acronyms are only upper letter without parentheses. Hope you can help me, Guillaume |
#5
|
|||
|
|||
Try reading this to help you understand how to compile a wildcard search.
https://wordmvp.com/FAQs/General/UsingWildcards.htm Test your wildcard searches using find and replace and when you have it working transfer the find and replace terms to your macro. The \( and \) means that you are enclosing your search in () which is what youu say specifically doesn't exist in your document. |
#6
|
||||
|
||||
Because your acronyms are not enclosed in parentheses, you need to delete the following two lines from the code:
.Start = .Start + 1 .End = .End - 1
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
Hello,
I had already removed the 2 lines .Start = .Start + 1 .End = .End - 1 as i statued they were the 1st and last characters of the acronym so respectively "(" and ")". Unfortunately i still have a error "5560" and the ".Execute" is highlighted (yellow). When i use "[A-Z]{2}" instead of "[A-Z]{2,}" every word with 2 upper letter are selected. Once i put the "," in the expression, i have the '5560' error. Thank you, |
#8
|
||||
|
||||
The error when using ',' is probably due to your regional settings being for a non-English language. Try using:
"[A-Z]{2;}"
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
Yes...it worked.
Thanks a lot ! |
#10
|
|||
|
|||
Assistance, Macro Newbie
Hi,
I'm looking at the macro provided, and have not worked with macros since the 90s. I understand that with each document you would need to enter the table number in this line: Set oTbl = .Tables(INSERT TABLE NUMBER) Where would I need to make changes for the Acronym to be entered into the First Column, and Definition in the second? Is this correct? .Last.Cells(1).Range.Text = strFnd .Last.Cells(2).Range.Text = strDef I ran a test across a document and I ended up the number of times the acronym was used in the document in the second column rather than the definition? I am using the code provided that also removes and adds rows as identified. Cheers, Chrissy |
#11
|
||||
|
||||
All you need change is:
With oTbl.Cell(i, 2).Range to: With oTbl.Cell(i, 1).Range
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#12
|
|||
|
|||
Acronym Finder Assistance
Thank you. Can I please just verify in entirity:
Code:
Sub Acronyms() Application.ScreenUpdating = False Dim RngDoc As Range, oTbl As Table, i As Long, j As Long Dim strAcr As String, strFnd As String, strDef As String strAcr = "," Set RngDoc = ActiveDocument.Range With ActiveDocument Set oTbl = .Tables(INSERT TABLE NUMBER) RngDoc.Start = oTbl.Range.End For i = 2 To oTbl.Rows.Count With oTbl.Cell(i, 1).Range strFnd = Left(.Text, Len(.Text) - 2) strAcr = strAcr & strFnd & "," End With Next With RngDoc With .Find .ClearFormatting .Replacement.ClearFormatting .Format = False .Forward = True .Text = "\([A-Z][A-Za-z0-9]@\)" .MatchWildcards = True .Execute End With Do While .Find.Found .Start = .Start + 1 .End = .End - 1 strFnd = .Text If InStr(strAcr, "," & strFnd & ",") = 0 Then strAcr = strAcr & strFnd & "," strDef = Trim(InputBox("New Term Found: " & strFnd & vbCr & _ "Add to definitions?" & vbCr & _ "If yes, type the definition.")) If strDef <> vbNullString Then With oTbl.Rows .Add .Last.Cells(1).Range.Text = strFnd .Last.Cells(2).Range.Text = strDef End With End If End If .Collapse wdCollapseEnd .Find.Execute Loop End With For i = oTbl.Rows.Count To 2 Step -1 With oTbl.Cell(i, 2).Range strFnd = Left(.Text, Len(.Text) - 2) End With Set RngDoc = ActiveDocument.Range With RngDoc With .Find .ClearFormatting .Replacement.ClearFormatting .Format = False .Forward = True .Text = strFnd .MatchWholeWord = True .MatchWildcards = False .MatchCase = True .Execute End With j = 0 Do While .Find.Found j = j + 1 .Collapse wdCollapseEnd .Find.Execute Loop End With If j < 2 Then oTbl.Rows(i).Delete Else oTbl.Cell(i, 3).Range.Text = j - 1 End If Next End With Set RngDoc = Nothing: Set oTbl = Nothing Application.ScreenUpdating = True End Sub Last edited by macropod; 05-10-2018 at 06:55 PM. Reason: Added code tags |
#13
|
||||
|
||||
If you change the table #, the code will not check for acronyms occurring anywhere before that table.
You would only swap strDef & strFnd around in: .Last.Cells(1).Range.Text = strDef .Last.Cells(2).Range.Text = strFnd if you want to change the output columns for the definitions and their acronyms. PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#14
|
|||
|
|||
Hi. I am quite lost. I don't understand why Paul's macro does nothing but endlessly churn on my 30-page proposal document. I don;lt understand what I have to do to the document to make it work, though I have read the instructions several times. Do I have to first create a three-column table at the beginning of the document? That doesn't make sense, because I don't know how many rows will be needed.
I need to create an acronym list, which will appear in a two-column table that the macro creates for the purpose, with acronym's in one column and their full names in the other, presumably acronyms on the left. I had a macro that did this years ago but cannot find it now. Help, please? |
#15
|
||||
|
||||
The code in post #2 was written to check against a list of known acronyms listed in a table at the start of the document. Perhaps you've forgotten about the code I provided in: https://www.msofficeforums.com/word-...generator.html
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
acronym, macro, table |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Auto correct for Acronym | mam9 | Word | 3 | 11-19-2012 01:35 AM |
Macro for microsoft Word | blukava | Word VBA | 7 | 05-27-2012 02:43 PM |
Function Finder | Kevin18014 | Excel | 3 | 01-02-2012 04:47 PM |
Macro - Microsoft Word 2010 | OfficeHelpSG | Word | 3 | 10-18-2011 11:54 AM |
Please help with a macro in Microsoft Word 2007 | AKMMS | Word VBA | 0 | 06-23-2010 02:16 PM |