View Single Post
 
Old 09-12-2012, 06:36 AM
jperez84 jperez84 is offline Windows XP Office 2007
Novice
 
Join Date: Sep 2012
Posts: 21
jperez84 is on a distinguished road
Default

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,
Reply With Quote