Creat an Acronyms List (which includes text surrounding the found acronyms)

[EzySetup]

I'm using the following macro to generate an acronyms list. It creates a new Word document with the acronym and the page number the acronym appears upon. I'd like to have the macro also return the text of the sentence in which the acronym appears. But the best I've been able to accomplish is for it to just repeat the sentence that appears after the first acronym found. I'm not a coder by any stretch of the imagination, which is likely why I can't figure out what needs to be modified in order to accomplish what I need.

Any help will be greatly appreciated.

Thanks in advance,
Andrew


Sub GetAcronyms()
'A basic Word macro coded by Greg Maxey
'link suppressed due to forum rules
Dim oCol As New Collection
Dim oColPN As New Collection
Dim oColTxt As New Collection 'new
Dim strTxt As String 'new
Dim oRng As Word.Range
Dim oDoc As Word.Document
Dim lngIndex As Long
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "<[A-Z]{1,4}>"
.MatchWildcards = True

'new
With Selection
' Expand selection to current sentence.
.Expand Unit:=wdSentence
End With
strTxt = Selection.Text

While .Execute
On Error Resume Next
oCol.Add oRng.Text, oRng.Text
'Uncomment the following to add the page number of the acronym. Also swap commented row near bottom.
If Err.Number = 0 Then
oColPN.Add oRng.Information(wdActiveEndPageNumber)

oColTxt.Add strTxt 'new

End If
On Error GoTo 0
oRng.Collapse wdCollapseEnd
Wend
End With
Set oDoc = Documents.Add
For lngIndex = 1 To oCol.Count
'oDoc.Range.InsertAfter oCol(lngIndex) & " " & oColPN(lngIndex) & vbCr 'original
oDoc.Range.InsertAfter oCol(lngIndex) & vbTab & oColPN(lngIndex) & vbTab & oColTxt(lngIndex) & vbCr
'oDoc.Range.InsertAfter oCol(lngIndex) & vbCr
Next lngIndex
End Sub

[gmayor]

The following should work. Note that the results are placed in a table for ease of sorting.

Option Explicit

Sub GetAcronyms()
'A basic Word macro coded by Greg Maxey
'http://gregmaxey.mvps.org/word_tips.html
'Modified by Graham Mayor
'http://www.gmayor.com
Dim oCol As New Collection
Dim oColPN As New Collection
Dim oColTxt As New Collection
Dim oTable As Table
Dim oCell As Range
Dim oRng As Word.Range
Dim oDoc As Word.Document
Dim lngIndex As Long
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "<[A-Z]{1,4}>"
.MatchWildcards = True
While .Execute
oCol.Add oRng.Text
oColTxt.Add oRng.Sentences(1).Text
oColPN.Add oRng.Information(wdActiveEndPageNumber)
oRng.Collapse wdCollapseEnd
Wend
End With
Set oDoc = Documents.Add
Set oTable = oDoc.Tables.Add(oDoc.Range, 1, 3)
oTable.Columns(1).Width = CentimetersToPoints(2.5)
oTable.Columns(2).Width = CentimetersToPoints(1.5)
oTable.Columns(3).Width = CentimetersToPoints(11.5)

For lngIndex = 1 To oCol.Count
Set oCell = oTable.Rows.Last.Cells(1).Range
oCell.End = oCell.End - 1
oCell.Text = oCol(lngIndex)
Set oCell = oTable.Rows.Last.Cells(2).Range
oCell.End = oCell.End - 1
oCell.Text = oColPN(lngIndex)
Set oCell = oTable.Rows.Last.Cells(3).Range
oCell.End = oCell.End - 1
oCell.Text = oColTxt(lngIndex)
If lngIndex < oCol.Count Then oTable.Rows.Add
Next lngIndex

oTable.Sort ExcludeHeader:=False, FieldNumber:="Column 1", _
SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
FieldNumber2:="Column 2", SortFieldType2:=wdSortFieldNumeric, SortOrder2 _
:=wdSortOrderAscending

lbl_Exit:
Set oDoc = Nothing
Set oRng = Nothing
Set oTable = Nothing
Set oCell = Nothing
Set oCol = Nothing
Set oColPN = Nothing
Set oColTxt = Nothing
Exit Sub
End Sub

[EzySetup]

Wow! This is great stuff. It works perfectly.

But question: I'm really not figuring out what "oRng.Collapse wdCollapseEnd" is doing. Can you explain it?

Thanks again,
Andrew

[gmaxey]

Andrew,

In this particular case it serves no real purpose but IMHO it is a good practice to get in the habit of using it. For more see the piece on continuous loops at:
http://gregmaxey.mvps.org/word_tip_pages/words_fickle_vba_find_property.html

[gmaxey]

I would probably change: .Text = "<[A-Z]{1,4}>"
to .Text = "<[A-Z]{2,4}>" as "A" and "I" are more frequently used as words rather than acronyms (unless you are an Electrician)

[EzySetup]

Thanks again Greg. (And, yes, I already changed the .Text values. I made them {2,5}, as in my industry I have a number of 5 character acronyms.)