View Single Post
 
Old 01-22-2014, 03:22 PM
macropod's Avatar
macropod macropod is offline Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
Note: Although you defined an acronym as "An acronym in this case consists of AT LEAST two capital letters", the code tests any parenthetic single-word alpha-numeric string beginning with a capital letter; it's up to you to decide whether to add that string to the acronym list or skip it. The enhanced code also assumes the table has a header row.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote