Search for words starting in capitals

[surreytom]

Hi,

I have a contract (I'm using MS Word 2010 but have a 2003 document) that I need to extract the 'defined terms' from and write to another file. That is to say, the words that are capitalised that are not the first word of a sentence. The entire document needs to be searched.

Sometimes a defined term has more than one word, for example, "Service Measures". In this instance I would ideally like "Service Measures" to be found rather than two results: "Service" and "Measures".

I have found the following wildcard search that finds words that begin with capitals that are not at the start of a sentence however this also returns the two preceding characters of the word:

[!.\!\?] <[A-Z][A-z0-9]{1,}>



However I am not sure how to:
a) export the return of the search to another document (to generate and build a list of defined terms)
b) delete the two preceding characters to just leave the capitalised words
c) run the macro for the entire document
d) edit the macro to group immediately subsequent words together (eg the "Service Measure" example above)

Any help that anyone can offer would be greatly appreciated!

Tom

[macropod]

Hi Tom,

Give the following macro a try. As coded, it outputs the word list in a sorted table at the end of the document.

Sub GetKeyWords()
Application.ScreenUpdating = False
Dim Rng1 As Range, Rng2 As Range, StrOut As String, StrExcl As String
StrOut = vbCr
StrExcl = ",A,But,He,Her,I,It,Not,Of,She,The,They,To,We,Who,You,"
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-Z][A-z0-9]{1,}>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    Set Rng1 = .Duplicate
    If InStr(StrExcl, "," & Trim(Rng1.Text) & ",") > 0 Then GoTo NextWord
    Rng1.MoveStart wdWord, -1
    On Error Resume Next
    If Not Rng1.Characters.First.Text Like "[.?!]" Then
      Set Rng2 = .Duplicate
      While Rng2.Words.Last.Next.Characters.First.Text Like "[A-Z&]"
        Rng2.MoveEnd wdWord, 1
      Wend
    End If
    If InStr(StrOut, vbCr & Rng2.Text & vbCr) = 0 Then
      StrOut = StrOut & Rng2.Text & vbCr
    End If
NextWord:
    On Error GoTo 0
    .Start = Rng1.End
    If Not Rng2 Is Nothing Then .Start = Rng2.End
    Set Rng2 = Nothing
    .Find.Execute
  Loop
End With
With ActiveDocument
  Set Rng1 = .Range.Characters.Last
  With Rng1
    .InsertAfter vbCr & Chr(12) & StrOut
    .Start = .Start + 2
    .Characters.First.Delete
    .ConvertToTable Separator:=vbTab, Numcolumns:=1
    .Tables(1).Sort Excludeheader:=False, FieldNumber:=1, _
      SortFieldType:=wdSortFieldAlphanumeric, _
      SortOrder:=wdSortOrderAscending, CaseSensitive:=False
  End With
End With
Set Rng1 = Nothing
Application.ScreenUpdating = True
End Sub

Note: The code provides for a list of excluded words that, if they begin a series of capitalised words, will not be reported. A limitation on the processing is that whatever words (other than those in the exclusions list) start a paragraph will also be included in the list. Conversely, if a keyword you're interested in starts a sentence within a paragraph, it will be missed (unless it appears somewhere other than at the start of a sentence as well).

[macropod]

Hi Tom,

On reflection, I think you might do better to start off with a known glossary of all possible/likely terms, which can copied into a document then be trimmed to reflect only the terms used in that document. See: http://www.vbaexpress.com/forum/showthread.php?t=41026

[surreytom]

Paul,Thanks very much for getting back to me. I'll have a look at both of your suggestions tomorrow when I am in the office and let you know how I get on.


Tom