Find and Copy loop problem

[Guest]

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]

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

 

[Guest]

It works until I try to loop through. I get an error on this line

Loop While FoundCell.Address <> FirstAddress

"Tun-time error '91': Obbject variable or With block variable not set"

Any suggestions?

 

[Dave Peterson]

You changed the code--I bet you got rid of the Y so you don't process it next
time!

One fix:

Option Explicit
Sub testme()

Dim RngToSearch As Range
Dim FoundCell As Range
Dim DestCell As Range

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
Do
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
Exit Do
End If

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

FoundCell.ClearContents
Loop
End With

Application.CutCopyMode = False

End Sub