VBA code to compile one document based on multiple search terms

Hoxton118 · #1 06-06-2014, 09:12 AM

I have the following code which allows me to select a search term and create a single new document which includes only those paragraphs containing the search term. I enter the search term in an input box.

Is there a way of getting the code to use a list of search terms from another file (whether Excel or Word) so that, rather than entering each search term individually, it will do multiple search terms at once - all results ending up in one document.

Another solution would be to enable a Boolean search in the input box, so that I could ask for multiple search terms there.

I would be very grateful for any help. Thanks.

Code:

Sub CreateSummary()
'
' CreateSummary Macro

Selection.Find.ClearFormatting
With Selection.Find
 .Text = InputBox("Type search term and press Enter.")
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While Selection.Find.Execute
Selection.StartOf Unit:=wdParagraph
Selection.MoveEnd Unit:=wdParagraph
sBigString = sBigString + Selection.Text
Selection.MoveStart Unit:=wdParagraph

Loop
Documents.Add DocumentType:=wdNewBlankDocument
Selection.InsertAfter (sBigString)
End Sub

macropod · #2 06-06-2014, 04:34 PM

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.

Hoxton118 · #3 06-09-2014, 02:40 AM

Many thanks Paul - that works a treat. Excellent.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Vba macro code for grouping the data based on 2 hours time	dharani suresh	Excel Programming	5	04-29-2014 03:25 AM
Search and replace/insert HTML code into Master File using tags	dave8555	Excel	2	02-23-2014 03:51 PM
Character based Search and Replace font size	anacond11	Word	2	08-08-2013 08:10 AM
How do I search for terms in initial upper-case?	bertietheblue	Word	5	05-02-2012 05:24 AM
Modify vba code to print based on name in the InputBox	OTPM	Project	0	05-25-2011 02:03 AM