Try the following. It assumes:
• you have a word list in another document, with each word/expression you want to find separated by paragraph breaks;
• the document to be processed in the active document; and
• a new document is to be created for the output.
Code:
Sub CreateSummary()
Application.ScreenUpdating = False
Dim FRDoc As Document, SrcDoc As Document, RsltDoc As Document, FRList, i As Long, Rng As Range
'Load the strings from the reference doc into a text string to be used as an array.
Set SrcDoc = ActiveDocument
Set FRDoc = Documents.Open("Drive:\FilePath\ReferenceList.doc")
FRList = FRDoc.Range.FormattedText
FRDoc.Close False
Set FRDoc = Nothing
Set RsltDoc = Documents.Add
'Process each string from the reference doc
For i = 0 To UBound(Split(FRList, vbCr)) - 1
With SrcDoc.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
.Text = Split(FRList, vbCr)(i)
.Execute
End With
Do While .Find.Found
Set Rng = RsltDoc.Characters.Last
Rng.Collapse wdCollapseStart
Rng.FormattedText = .Duplicate.Paragraphs.First.Range.FormattedText
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
Application.ScreenUpdating = True
End Sub
Note: you will need to replace 'Drive:\FilePath\ReferenceList.doc' with the correct filepath & name for your reference document.