View Single Post
  #2   Report Post  
Dave Peterson
 
Posts: n/a
Default Find and Copy loop problem

RngToFind is gonna be a single cell (if "Y" was found).

Excel's help shows a way of keeping track of the first found cell address and
looping to look for more--until excel wraps around and finds that cell with the
first address again.

Option Explicit
Sub testme()

Dim RngToSearch As Range
Dim FoundCell As Range
Dim DestCell As Range
Dim FirstAddress As String

With Worksheets("Bid Generation")
'Set RngToSearch = .Range("G9:G1003")
'or use the last cell in column G?
Set RngToSearch = .Range("g9", .Cells(.Rows.Count, "G").End(xlUp))
End With

With RngToSearch
Set FoundCell = .Cells.Find(what:="Y", _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
MsgBox "Not found!"
Exit Sub
End If

FirstAddress = FoundCell.Address
Do
With Worksheets("bid log")
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

FoundCell.Offset(0, 1).Resize(1, 2).Copy
DestCell.PasteSpecial Paste:=xlPasteValues

Set FoundCell = .FindNext(after:=FoundCell)

Loop While FoundCell.Address < FirstAddress

End With

Application.CutCopyMode = False

End Sub




BillyJ wrote:

I am trying to create a macro that defines a range, and if it finds a cell
with a "Y" in it copies and moves the cells next to it. Unfortunately, it
doesn't seem to do any finding. I just copies whatever it is next to. I'm
probably not defining the loop correctly. Any help?

Dim RngToSearch As Range
Dim RngToFind As Range
Dim RngCopy As Range

Sheets("Bid Generation").Select
Set RngToSearch = Range("G9:G1003")
Set RngToFind = RngToSearch.Find("Y")

If RngToFind Is Nothing Then
Else
For Each cell In RngToFind
ActiveCell.Offset(0, 1).Range("A1:B1").Copy
Sheets("Bid Log").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Bid Generation").Select
Next
End If


--

Dave Peterson