Nested loop

[giel.vanboxtel]

Hi,

I want to make a nested loop. Or something to compare the value of
cells.
The first loop will step through all of the cells in column A starting
with "A1".
then the seccond loop will start. This one steps through column B
starting with "B1" until there is an empty cell
If object 1 matches object 2 it will copy the row to the second sheet:

This is what I got until now, second loop (this is the part where I go
trough column B)
in this example I used "123" this could be "obj1" from the first loop.

Public Sub test2()

Dim obj2
Dim d, e As Integer
d = 1
e = 2

Cells(d, e).Select
obj2 = ActiveCell

Do Until obj2 = 123
d = d + 1
Cells(d, e).Select
obj2 = ActiveCell
If obj2 = 123 Then Exit Do
Loop

ActiveCell.EntireRow.Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown

End Sub

Thanks in advance
--Giel

 

[Guest]

For looping through a range, I would use a For/Each loop (or the Find method
- but that required more typing):

Sub test()
Const lngCriteria As Long = 123
Dim rngCell As Range
Dim rngSource As Range
Dim wksDest As Worksheet

Set rngSource = Intersect(Sheets("Sheet1").Columns(1), _
Sheets("Sheet1").UsedRange)
Set wksDest = Sheets("Sheet2")

For Each rngCell In rngSource.Cells
If rngCell.Value = lngCriteria Then
If rngCell.Offset(0, 1).Value = lngCriteria Then
rngCell.EntireRow.Copy wksDest.Range("A1")
wksDest.Range("A1").EntireRow.Insert Shift:=xlDown
End If
End If
Next rngCell

End Sub