Subscribe now and choose from over 30 free gifts worth up to £49 - Plus get £25 to spend in our shop
I'm trying to get a macro to run through a Word document and extract all the acronyms. I've found a reasonable macro that does this. The only problem is that it adds the abbreviation list to a table in the document being scanned. I want it put it in a new word document. I've tried editing the code, but I'm an absolute beginner at this stuff. Can anyone help:
Sub AcronymExtract()
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 = 0 Then
oTbl.Rows(i).Delete
Else
oTbl.Cell(i, 3).Range.Text = j
End If
Next
End With
Set RngDoc = Nothing: Set oTbl = Nothing
Application.ScreenUpdating = True
End SubWhat I can help you with is making that text vaguely readable. I've edited your post for you.
I think the simplest method would be to let the macro create its table, then once complete, copy-paste that table into a new document, then go back and delete the one in the original.
In days gone by with older versions of office I would normally use the record macro button to do some of the steps I wanted. Once recorded, then I would look at the code it created and modify it to suit.
For example, It would be easy to record a new macro that records you doing the following:
selecting the created table and copying it to clipboard.
file -> new file
paste from clipboard into new file
return to original document
delete selected table
once saved, the code will be daily straightforward / understandable and could be merged onto the end of the code that creates the table in the first place.