View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Ron de Bruin Ron de Bruin is offline
external usenet poster
 
Posts: 11,123
Default Modifying FindNext and Copy Code

Try this

This example use Sheet1 and Sheet2
and this range Sheets("Sheet1").Range("A1:A100")

Change to yours

Sub Copy_To_Another_Sheet_1()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long

Application.ScreenUpdating = False
'You can also use more values in the Array
'myArr = Array("@", "www")
MyArr = Array("Funky: Ticket Before Notify")

Rcount = 0
With Sheets("Sheet1").Range("A1:A100")

For I = LBound(MyArr) To UBound(MyArr)
'If you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "Funky: Ticket Before Notify"
'Note : I use xlPart in this example and not xlWhole

Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
' This example will only copy the value
Rng.EntireRow.Copy Sheets("Sheet2").Range("A" & Rcount)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address < FirstAddress
End If
Next I
End With
Application.ScreenUpdating = True
End Sub

--
Regards Ron de Bruin
http://www.rondebruin.nl


" wrote in message ...
I am trying modify code that Tom Ogilvy provided in a post
on 8/23/04 to basically do the same steps required in
Lolly's original post, except that I want to cut the
entire row out of the first worksheet and paste it into
a second worksheet. My problem is that I'm only getting
one out of the five records I know exist in the
spreadsheet, and I'm sure the issue is between the "Else"
and "Loop" statement. So far, the code looks like this:

Dim rng As Range, rng1 As Range
Application.Worksheets("Pivot Data").Select
Set rng = Range("PivotData").Find(What:="Funky: Ticket
Before Notify", _
LookAt:=xlWhole, LookIn:=xlValues)
If rng Is Nothing Then
MsgBox "Data Not Found"
Exit Sub
Else
Set rng1 = rng
Do While rng1.Offset(1, 0).Value = "Funky: Ticket
Before Notify"
Set rng1 = rng1.Offset(1, 0)
Loop
Range(rng, rng1).EntireRow.Copy _
Destination:=Application.Worksheets("Errors").Rang e
("A2")
End If

I'm pretty sure I'm not giving the loop the correct
instruction, but I don't know how to fix it. The text
string that I'm looking for is in Column V (Column 22).

Any help would be very much appreciated.

Thanks in advance,

Val