VBA script to leave only unique rows

[davidlatics]

Hi, I wonder if anyone can help me please – I’ve tried searching previous posts but I’m unable to find a solution to my query.

Spreadsheet 1 consists of hundreds of rows of data - a sample is below. Spreadsheet 2 includes exactly the same rows as Spreadsheet 1, plus a handful of new entries. However, these new rows could be located anywhere within the sheet.

I would like to find a way of deleting all the duplicate rows on Spreadsheet 2 (when compared with Spreadsheet 1) to leave only the new rows. I have to repeat this process each day (i.e. comparing that day’s data to the previous day) so any help would be massively appreciated. I am using Office 365.

NA 0115.xlsx
	A	B	C	D	E	F	G	H	I
1	Op. Al	Origin	DepAptName		DepCtryName	ArrAptName	ArrCityName	ArrCtryName	Destination
2	2D	BOS	Boston Edward L Logan Intl Apt		USA	Belo Horizonte Tancredo Neves Int Apt	Belo Horizonte	Brazil	CNF
3	2D	YYZ	Toronto Lester B Pearson Intl		Canada	Georgetown (GY) 00	Georgetown (GY) 00	Guyana	GEO
4	4B	CNM	Carlsbad		USA	El Paso International Apt	El Paso	USA	ELP
5	4B	ELP	El Paso International Apt		USA	Carlsbad	Carlsbad	USA	CNM
6	AA	AUS	Austin-Bergstrom International Apt		USA	Boston Edward L Logan Intl Apt	Boston	USA	BOS
7	AA	AUS	Austin-Bergstrom International Apt		USA	Orlando International Apt	Orlando	USA	MCO
8	AA	AUS	Austin-Bergstrom International Apt		USA	San Jose Norman Y. Mineta Intl	San Jose (US)	USA	SJC
9	AA	BOS	Boston Edward L Logan Intl Apt		USA	Austin-Bergstrom International Apt	Austin (US) TX	USA	AUS
10	AA	BOS	Boston Edward L Logan Intl Apt		USA	Fort Lauderdale/Hollywood Intl Apt	Fort Lauderdale	USA	FLL
11	AA	BOS	Boston Edward L Logan Intl Apt		USA	Hilton Head Island	Hilton Head Island	USA	HHH
12	AC	YOW	Ottawa McDonald - Cartier Intl Apt		Canada	Cayo Coco	Cayo Coco	Cuba	CCC
13	AC	YUL	Montreal Pierre Elliott Trudeau Int Apt		Canada	Toulouse	Toulouse	France	TLS
14	AC	YYZ	Toronto Lester B Pearson Intl		Canada	Brussels Airport	Brussels	Belgium	BRU
15	AS	AUS	Austin-Bergstrom International Apt		USA	Los Angeles International Apt	Los Angeles (US)	USA	LAX
16	AS	BOI	Boise		USA	Everett	Everett	USA	PAE
17	AZ	SFO	San Francisco		USA	Rome Fiumicino Apt	Rome (IT)	Italy	FCO
18	B6	ATL	Atlanta Hartsfield-jackson Intl Apt	Atlanta	USA	Newark Liberty International Apt	New York	USA	EWR
Sheet1

 

[ER_Neha]

in your table, is the arraptname the unique member ? because as I can see there are duplicates in all other column except the arraptname column. can you please enlighten

 

[JamesCanale]

If you want a VBA code, some code can be done - some people on here amaze me with the brevity of how they write code (I've been meat-balling excel code for 25 years.)

But you might use column J on both spreadsheets as =concatenate(a2,b2,c2,...i2)

Then in column k of the new sheet =ifna(vlookup(j2,sheet1!$j$2:$j$99,1,false),"NEW DATA")

Delete anything that isn't "NEW DATA". Of course, if I had to do it every day, I'd write some code for it. I'd want to load a variable array with the concatenated values from sheet1 then go to sheet 2 and compare each concatenated row to the array from sheet one and if it was found, delete the row. But I'll be interested in how some of the real pros would do it with less code and more speed.

 

[davidlatics]

in your table, is the arraptname the unique member ? because as I can see there are duplicates in all other column except the arraptname column. can you please enlighten

Hi, no unfortunately there are no unique members. For example, here is today's spreadsheet with the new row highlighted in red. The rest of the sheet remains the same, apart from the new row.

Op. Al	Origin	DepAptName		DepCtryName	ArrAptName	ArrCityName	ArrCtryName	Destination
2D	BOS	Boston Edward L Logan Intl Apt		USA	Belo Horizonte Tancredo Neves Int Apt	Belo Horizonte	Brazil	CNF
2D	YYZ	Toronto Lester B Pearson Intl		Canada	Georgetown (GY) 00	Georgetown (GY) 00	Guyana	GEO
4B	CNM	Carlsbad		USA	El Paso International Apt	El Paso	USA	ELP
4B	ELP	El Paso International Apt		USA	Carlsbad	Carlsbad	USA	CNM
AA	AUS	Austin-Bergstrom International Apt		USA	Boston Edward L Logan Intl Apt	Boston	USA	BOS
AA	AUS	Austin-Bergstrom International Apt		USA	Orlando International Apt	Orlando	USA	MCO
AA	AUS	Austin-Bergstrom International Apt		USA	San Jose Norman Y. Mineta Intl	San Jose (US)	USA	SJC
AA	BOS	Boston Edward L Logan Intl Apt		USA	Austin-Bergstrom International Apt	Austin (US) TX	USA	AUS
AA	BOS	Boston Edward L Logan Intl Apt		USA	Fort Lauderdale/Hollywood Intl Apt	Fort Lauderdale	USA	FLL
AA	BOS	Boston Edward L Logan Intl Apt		USA	Hilton Head Island	Hilton Head Island	USA	HHH
AA	EWR	Newark Liberty International Apt		USA	Belo Horizonte Tancredo Neves Int Apt	Belo Horizonte	Brazil	CNF
AC	YOW	Ottawa McDonald - Cartier Intl Apt		Canada	Cayo Coco	Cayo Coco	Cuba	CCC
AC	YUL	Montreal Pierre Elliott Trudeau Int Apt		Canada	Toulouse	Toulouse	France	TLS
AC	YYZ	Toronto Lester B Pearson Intl		Canada	Brussels Airport	Brussels	Belgium	BRU
AS	AUS	Austin-Bergstrom International Apt		USA	Los Angeles International Apt	Los Angeles (US)	USA	LAX
AS	BOI	Boise		USA	Everett	Everett	USA	PAE
AZ	SFO	San Francisco		USA	Rome Fiumicino Apt	Rome (IT)	Italy	FCO
B6	ATL	Atlanta Hartsfield-jackson Intl Apt	Atlanta	USA	Newark Liberty International Apt	New York	USA	EWR

 

[aRandomHelper]

Is your end goal to know which one is new, and the new list of all unique rows will be back in Sheet 1 again (preparing for next day's data)?

If yes, you can try this. This assumes your data starts from A1:

Sub me1158814_removedupes()
    Dim ws1 As Worksheet, ws2 As Worksheet, r As Long, i As Long, a
    Set ws1 = Sheets("Sheet1") 'edit accordingly
    Set ws2 = Sheets("Sheet2") 'edit accordingly
   
    r = ws1.Cells(1, 1).CurrentRegion.Rows.Count + 1
    With ws2.Cells(1, 1).CurrentRegion
        ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Value = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Value
        ReDim a(0 To .Columns.Count - 1)
        For i = 0 To UBound(a)
            a(i) = i + 1
        Next
    End With
    ws1.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=(a), Header:=xlYes
    With ws1.Cells(1, 1).CurrentRegion
        .Range(.Cells(r, 1), .Cells(.Rows.Count, .Columns.Count)).Font.Color = vbRed
    End With
End Sub

It moves whatever you have in Sheet2 into Sheet1, and uses Excel's built in function to remove duplicates. New unique rows that was from Sheet2 will now be in red font in Sheet1 (at the bottom of the list).

 

[davidlatics]

Is your end goal to know which one is new, and the new list of all unique rows will be back in Sheet 1 again (preparing for next day's data)?

If yes, you can try this. This assumes your data starts from A1:

Sub me1158814_removedupes()
    Dim ws1 As Worksheet, ws2 As Worksheet, r As Long, i As Long, a
    Set ws1 = Sheets("Sheet1") 'edit accordingly
    Set ws2 = Sheets("Sheet2") 'edit accordingly
  
    r = ws1.Cells(1, 1).CurrentRegion.Rows.Count + 1
    With ws2.Cells(1, 1).CurrentRegion
        ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Value = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Value
        ReDim a(0 To .Columns.Count - 1)
        For i = 0 To UBound(a)
            a(i) = i + 1
        Next
    End With
    ws1.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=(a), Header:=xlYes
    With ws1.Cells(1, 1).CurrentRegion
        .Range(.Cells(r, 1), .Cells(.Rows.Count, .Columns.Count)).Font.Color = vbRed
    End With
End Sub

It moves whatever you have in Sheet2 into Sheet1, and uses Excel's built in function to remove duplicates. New unique rows that was from Sheet2 will now be in red font in Sheet1 (at the bottom of the list).

Thanks so much - this is exactly what I was looking for.