Find and FindNext

[StumpedAgain]

I'm trying to copy all products in a database with common startnames onto a
different sheet. I can successfully copy the first instance, but am having
some trouble copying the next instance. After the program finds the next
instance of the product (if there is one) I don't want to copy the active
cell if there is no other product of that type. The following is what I'm
looking for:

Find product, copy and paste product (that much I have)
Find next product (of same/similar name) copy and past product
If no "next product" is found, go to next i

This is what I have so far:

With Worksheets("wsnew").Range("A60")
rowcount = Range(.Offset(1, 0), .End(xlDown)).Rows.count
End With

For i = 0 To rowcount
Dim printer As Range, FoundCell As String, rowcnt As Integer
Sheets("Data").Select
With ActiveSheet
Range("C8:C6000").Find(What:=curselection.Value).Activate
rowcnt = ActiveCell.Row
If ActiveCell.Offset(0, 3).Value Like "Discontinued" Then
If vbNo = MsgBox("Product " & curselection.Value & " has
been _
discontinued." & _
vbLf & "Would you still like to include it in your
analysis?", vbYesNo) Then
j = j - 1
End If
End If
ActiveCell.Copy Sheets("wsnew").Range("A7").Offset(i + j, 0)
End With

Range("C8:C6000").FindNext(After:=ActiveCell).Activate

Next i

If what I'm describing doesn't make enough sense, let me know and I can try
to explain further. Any help is greatly appreciated!!!

 

[Joel]

the Find next when you use "after" will loop back to the beginning of the
range and continue until you get back to the after cell. don't know if you
want to loop. Try this instead.


Sub stumped()

j = 0 'you didn't have j set to anything

With Worksheets("wsnew").Range("A60")
RowCount = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
End With

For i = 0 To RowCount
Dim printer As Range, FoundCell As String, rowcnt As Integer

With Sheets("Data").ActiveSheet
Set c = .Range("C8:C6000").Find(What:=curselection.Value)
If Not c Is Nothing Then
rowcnt = ActiveCell.Row
If c.Offset(0, 3).Value Like "Discontinued" Then
If vbNo = MsgBox("Product " & curselection.Value & _
" has been discontinued." & vbLf & _
"Would you still like to include it in your analysis?",
vbYesNo) Then

j = j - 1
End If
End If
c.Copy Destination:=Sheets("wsnew").Range("A7").Offset(i + j, 0)


LastAddr = c.Address
Do
Set c = .Range("C8:C6000").FindNext()
If c Is Nothing Then Exit Do
Loop While c.Address = LastAddr
End If
End With

Next i

End Sub

 

[StumpedAgain]

I had to modify the Do loop to copy the next entry, but other than that and a
couple minor tweaks, it works wonderfully! Thanks for the help!

Modified Do loop below:

Do
Set c = .Range("C8:C6000").FindNext()
If c.Address = LastAddr Then
Exit Do
Else
LastAddr = c.Address
j = j + 1
c.Copy Destination:=Sheets("wsnew").Range("A7").Offset(i
+ j, 0)
End If
Loop While c.Address = LastAddr

 

[StumpedAgain]

Appending my own post, I didn't realize that (as you said) it loops back and
selects the previous selection when I use the method FindNext(). Because it
did this, I had to change the range from

Set c = .Range("C8:C6000").FindNext()

to

Set c = .Range(LastAddr, "C6000").FindNext()

This eliminates duplicate entries.

Thanks again!