Copy Entire rows with a difference

[DB100]

Hi Tom

I run this and it looks like it is all working fine.

I turned screen updating on so that I could see it.

It seems to run and copy the row. But when it finishes..there i
nothing on sheet 3.

I am also a little concerned that it appears to be making actions i
rows 50000 + when the sheet only has 500 lines on it
any ideas ?

Thanks

Davi

 

[Tom Ogilvy]

This worked for me:

Sub UniqueList()
'Build a new unique list from two other lists.
'Works by checking list 1 for missing values in list 2.
'Note: List 1 cannot contain duplicates, but list 2 can!
'Standard Module code!
'Sheet1 is the master list of names.
'Sheet2 is the Raw data.
'Sheet3 gets the names that are in the raw data but not on the master List!

Set MyFunction = Application.WorksheetFunction
Set MyRange1 = Sheets("Sheet1").Range("A2:A5000")
Set MyRange2 = Sheets("Sheet2").Range("A2:A5000")
Set MyResults = Sheets("Sheet3").Range("A2")
On Error GoTo myFin

'Loop for list values.
'Sheets("Sheet1").Select
For Each cell In MyRange2
If IsEmpty(cell) Then GoTo myFin
'Sheets("Sheet2").Select
If MyFunction.CountIf(MyRange1, cell.Value) = 0 Then
'Sheets("Sheet3").Select
cell.EntireRow.Copy
MyResults.Offset(r, 0).PasteSpecial xlValues
r = r + 1
End If
Next cell

myFin:
Sheets("Sheet3").Select
Sheets("Sheet3").Range("A1").Select

End Sub