Special loop

[Rpettis31]

I am looking to make a loop where if a value is found in a row and that value
is not on sheet 2 then the row is copied and added to sheet 1.

 

[JLGWhiz]

I have read your post about five times and still am not sure what you are
saying.

It looks like you have three worksheets. Can you clarify where the value to
be compared is located by sheet and column. Then assuming that the item is
not located on sheet 2 anywhere, it is further assumed that the row
containing the search item is the one to be copied to somewhere on sheet 1,
probably the next available row. If you could clarify this, it would help in
developing the code.

 

[Rpettis31]

This what I am trying to do with two sheets. I have a loop that has counted
the number of filled lines on Sheet 2.
Loop - The next step is to look on sheet one and see how many rows have a
value in cell (x,1) If there is a value in cell(x,1) and then look on sheet
2 to see if the value from sheet 1 is on sheet 2 (nested loop) sheet2
cell(z,1). If the value on sheet one is not on sheet 2 then copy the row of
sheet one and past to sheet 2 to the filled line+1 (the first loop count).

 

[Dave Peterson]

Option Explicit
Sub testme02()

Dim WksF As Worksheet
Dim WksT As Worksheet
Dim myCell As Range
Dim myRng As Range
Dim res As Variant
Dim DestCell As Range

Set WksF = Worksheets("Sheet1")
Set WksT = Worksheets("sheet2")

With WksF
'header in row 1????
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In myRng.Cells
res = Application.Match(myCell.Value, WksT.Range("a:a"), 0)
If IsError(res) Then
'no match
With WksT
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
myCell.EntireRow.Copy _
Destination:=DestCell
End If
Next myCell

End Sub

Sometimes using a loop to check for values can be slow. Using
application.match() is the same =match() function that you can read about in
Excel's help (not VBA's help).

 

[Rpettis31]

Here is my code, it seems to work but it copys the line 200 times that is true.
Basically it is not copying the line in sequencial order. I think this may
have something to do with the speed of the program.


' Count number of filled lines
notempty = 1
Sheets("DLV CONTAINERS").Select
For filled = 2 To 1000
If Cells(filled, 1) <> "" Then notempty = notempty + 1
Next filled
Sheets("Data").Select
' Move DLV lines to DLV CONTAINERS Sheet
For dlv = 2 To 200
For dlv2 = 2 To 200
If Cells(dlv, 23) <> "" And Cells(dlv, 8) <> _
Sheets("DLV CONTAINERS").Cells(dlv2, 8) Then Rows(dlv).Copy Sheets("DLV
CONTAINERS").Range("A" & notempty + 1)
notempty = notempty + 1
Next dlv2
Next dlv

 

[JLGWhiz]

I modified Dave's code to use your sheet names. Put it in the standard VBA
module and test it on a copy of your workbook. It should run faster than the
one you posted. If I guessed wrong on the sheet names, just reverse them and
try again.

Option Explicit
Sub testme02()

Dim WksF As Worksheet
Dim WksT As Worksheet
Dim myCell As Range
Dim myRng As Range
Dim res As Variant
Dim DestCell As Range

Set WksF = Worksheets("Data") 'These might need change
Set WksT = Worksheets("DLV CONTAINERS")

With WksF
'header in row 1????
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In myRng.Cells
res = Application.Match(myCell.Value, WksT.Range("a:a"), 0)
If IsError(res) Then
'no match
With WksT
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
myCell.EntireRow.Copy _
Destination:=DestCell
End If
Next myCell

End Sub