View Single Post
 
Old 06-06-2014, 04:34 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

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.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote