View Full Version : 2 lists, copy unique rows

11-03-2013, 02:50 AM
Hi guys,

I am a novice to marco/vba and am hoping to get some guidance on extracing unique values based on two lists(2 sheets).

My scenario:

Sheet1 has one million lines of serial numbers (master sheet)
Sheet2 has 200,000 lines with same format. ColumnA=serial
sheet 2 has some new serials and some existing serials
Serial is 18 digit number saved as text (dunno of that matters)


how can I get vba to check serial agaisnt serial ( Sheet2 ColumnA against Sheet1 column A)
extract all new serials (unique of sheet 2 only)
unique lines to export to new sheet or replace sheet2

I am really unsure how to start this... any ideas or pointers?

I've googled my heart out for a week but haven't found anything that works.. I've found formulas& excel functions but they keep crashing my comp because of large data in sheet 1. :(

Thanks in advance for any advice and your time!

11-03-2013, 04:19 AM
can you attach a very small sample file with data and desired result ?

11-03-2013, 03:24 PM
welcome to the forum.

you want to copy cells from Sheet2 to Sheet3 which are not present in Sheet1.

this is a VBA solutioun which uses countif formula to detect nonmatching cells.

i dont know how much time it took to complete the procedure.

because i left the application after seeing in the progress bar that only 15% of the calculations are completed in 10 minutes with 8 processors. :)

i assume A1 contains a header.

Sub copy_nonmatching_cells()

Dim Rng
Dim Calc As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With

Set Rng = Worksheets("Sheet2").Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

With Rng
.Offset(, 1).Formula = "=CountIf(Sheet1!A2:A1000000,A2)"
.Resize(, 2).AutoFilter , Field:=2, Criteria1:="0"
.Parent.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("A2")
End With

With Application
.EnableEvents = True
.Calculation = Calc
End With

End Sub