Sorry about the cross posting. I didn't think about someone doing double work or trying to solve a problem when someone on another forum already had.
I've been working on my above dilema and have a working macro(found it online and have been able to modify it a bit to my needs). I'm just trying to modify it a bit. Instead of searching 1 word or phrase at a time is there a way to have a list and it can pull from the next word or phrase with each loop until it hits the end? Also is the a way to number each hit and put it all into 1 doc. Below is the code that I have so far.
Code:
Sub Demo()
Dim SearchTerm As String, i As Long
Dim Rng As Range, Doc As Document, RngOut As Range
SearchTerm = InputBox("Enter your search terms")
SearchTerm = LCase(Trim(SearchTerm))
If Len(SearchTerm) = 0 Then Exit Sub
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = SearchTerm
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.Execute
End With
If .Find.Found Then
Set Doc = Documents.Add(Visible:=False)
Do While .Find.Found
Set Rng = .Duplicate
With Rng
.MoveStartUntil Cset:="^^^^^", Count:=wdBackward
.MoveEndUntil Cset:="^^^^^", Count:=wdForward
.Select
If MsgBox(.Text, vbYesNo, "Copy this block?") = vbYes Then
.Copy
With Doc
.Range.InsertAfter "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
Set RngOut = .Characters.Last
RngOut.Paste
End With
End If
End With
.Collapse wdCollapseEnd
.Find.Execute
Loop
Doc.Activate
ActiveWindow.Visible = True
End If
End With
End Sub
Thanks,