So I am trying to do a loop. I used the excel help but its not that
helpful. I am currently trying to do a find loop but also when the
word is found it is copy and pasted into a new column. That works
great but when I try to loop it so that it finds the next word to copy
and paste it pastes right over the old one. It also just keeps running
forever. It just keeps looping. So hopefully I can get some help from
you geniuses.

Dim y As Integer
Dim rng1 As Range
For y = 1 To 30 Step 4
With Worksheets(1).Range("a1:a500")
Set c = .Find("Item # 2", LookIn:=xlValues)
If Not c Is Nothing Then
Do
Range(c.Offset(0, 0), c.Offset(3, 1)).Copy
Range(Cells(y, 3), Cells(y, 4)).PasteSpecial

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress <----
not sure if neccesary its what was in the help.

End If
End With
Next
End Sub

For the problem of results being pasted on top of one another, your
PasteSpecial cell never changes because y is outside the Do loop. As for
the infinite loop, take a look at the unhelpful help article again :-)

"When the search reaches the end of the specified search range, it wraps
around to the beginning of the range. To stop a search when this wraparound
occurs, save the address of the first found cell, and then test each
successive found-cell address against this saved address."

This is why they compare c.Address to firstAddress, but you left out the
firstAddress = c.Address line

Try something like this (NOT TESTED!)

With Worksheets(1).Range("A1:A500)
Set c = .Find("Item # 2", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
y = 1
Do
Range(c.Offset(0,0), c.Offset(3,1)).Copy
Range(Cells(y,3), Cells(y,4)).PasteSpecial
Set c = .FindNext(c)
y = y + 4 <-------Adjust as needed
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With


wrote in message
ups.com...
So I am trying to do a loop. I used the excel help but its not that
helpful. I am currently trying to do a find loop but also when the
word is found it is copy and pasted into a new column. That works
great but when I try to loop it so that it finds the next word to copy
and paste it pastes right over the old one. It also just keeps running
forever. It just keeps looping. So hopefully I can get some help from
you geniuses.

Dim y As Integer
Dim rng1 As Range
For y = 1 To 30 Step 4
With Worksheets(1).Range("a1:a500")
Set c = .Find("Item # 2", LookIn:=xlValues)
If Not c Is Nothing Then
Do
Range(c.Offset(0, 0), c.Offset(3, 1)).Copy
Range(Cells(y, 3), Cells(y, 4)).PasteSpecial

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress <----
not sure if neccesary its what was in the help.

End If
End With
Next
End Sub