Need a macro to create a separate document that lists all capitalized words

[jojolisac]

I'm looking to create a list outside of the Word document that has all capitalized words within the document, but excludes sentence and paragraph starts.

Any help appreciated! Thanks.

 

[macropod]

You could use a macro like:

Sub Demo()
Application.ScreenUpdating = False
Dim SrcDoc As Document, DestDoc As Document
Set SrcDoc = ActiveDocument: Set DestDoc = Documents.Add
With SrcDoc.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[A-Z][A-Za-z]@>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    With .Words.First
      If .Start <> .Sentences.First.Start Then
        DestDoc.Range.Characters.Last.FormattedText = .FormattedText
        DestDoc.Range.InsertAfter vbCr
      End If
    End With
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub

For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm
For Mac macro installation & usage instructions, see: https://wordmvp.com/Mac/InstallMacro.html

 

[jojolisac]

This is great! And it does work, but it's pulling in some unwanteds for me.

It's working fine excluding paragraph starts, and also sentence starts, but still picking up sentence starts before tabs.

Also is it possible to only include a unique word in the list once?

Meaning, if there are multiples of the exact same capitalized word, only including it once in the list.

 

[macropod]

still picking up sentence starts before tabs.

I have no idea what you mean by that.

Also is it possible to only include a unique word in the list once?

Yes, but the code would need re-writing. Best if you provide more detail about the first issue before I do that.

 

[jojolisac]

I think I figured it out. Thank you so much! This will be very helpful.

 

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim SrcDoc As Document, DestDoc As Document, StrFnd As String, StrOut As String
Set SrcDoc = ActiveDocument: Set DestDoc = Documents.Add: StrOut = " "
With SrcDoc.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-Z][A-Za-z]@>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    StrFnd = .Text & " "
    With .Words.First
      If .Start <> .Sentences.First.Start Then
        If InStr(StrOut, " " & StrFnd) = 0 Then StrOut = StrOut & StrFnd
      End If
    End With
    .Collapse wdCollapseEnd
  Loop
End With
DestDoc.Range.Text = Replace(Trim(StrOut), " ", vbCr)
Application.ScreenUpdating = True
End Sub

 

[jojolisac]

This works perfectly! thank you.