Remove Duplicates - first instance

Afro_Cookie

Board Regular
Joined
Mar 17, 2020
Messages
103
Office Version
  1. 365
Platform
  1. Windows
I am populating data from a seporate workbook and there are duplicates that get transefered over in the process. I want to remove the duplicates, but keep the last entry. All the removal processes I've seen remove the first instance only, or require additional steps of adding columns to create a unique value and then delete the values and columns each time.

Is there a way to run through my table and based on Column A, delete duplicates, but keep the data in the lowest row/ highest numbered row? Or a reverse lookup, duplicate removal?
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
I'm not too fluent in Spanish so I used Google to translate, and here is an example of the table. In the end I would only want to show items: 3,9,10,11,12,13,15,16,17,18,19 left over.

ItemDescriptionDelivery Date Qty Status
1T17/7/202372,000N
2T17/28/202390,000N
3T17/28/20231,248N
4T27/28/20231,248Y
5T38/4/20231,248Y
6T78/4/20231,248B
7T78/4/20231,248Y
8T78/4/20231,248Y
9T78/4/20231,248Y
10T28/4/20231,248N
11T38/4/20231,248A
12T48/4/20231,248N
13T58/4/20231,248N
14T1008/4/20231,248N
15T508/4/20231,248N
16Tan8/4/20231,248Y
17Tbc8/4/20231,248Y
18Tbc8/4/20231,248N
19T1008/4/20231,248N
 
Upvote 0
Assuming you want to remove duplicates from Col B, top down, I don't think your list of item numbers should include 17 as its col B value of Tbc is duplicated by 18.
Here's a macro that should produce your desired output in cols G:K sorted on "Item".
VBA Code:
Sub DeleteDupsFromTop()
'Deletes dups from col B from top down
Dim sn, j As Long
sn = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Value
With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)  'put each row into a dictionary item using first column data which has the dups
        .Item(sn(j, 2)) = Application.Index(sn, j, 0)
    Next
    'Write edited (dup free in col A) list from cols A:E to cols G:K
    Range("G1:K1").Value = Range("A1:E1").Value
    Columns("G").Cells(2, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
    Range("G1").CurrentRegion.Sort key1:=[G2], order1:=xlAscending, Header:=xlYes
End With
End Sub
 
Upvote 0
Assuming you want to remove duplicates from Col B, top down, I don't think your list of item numbers should include 17 as its col B value of Tbc is duplicated by 18.
Here's a macro that should produce your desired output in cols G:K sorted on "Item".
VBA Code:
Sub DeleteDupsFromTop()
'Deletes dups from col B from top down
Dim sn, j As Long
sn = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Value
With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)  'put each row into a dictionary item using first column data which has the dups
        .Item(sn(j, 2)) = Application.Index(sn, j, 0)
    Next
    'Write edited (dup free in col A) list from cols A:E to cols G:K
    Range("G1:K1").Value = Range("A1:E1").Value
    Columns("G").Cells(2, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
    Range("G1").CurrentRegion.Sort key1:=[G2], order1:=xlAscending, Header:=xlYes
End With
End Sub
This does work in duplicating the data without the duplicates, but I then have to clear the initial data and transfer the filtered data into the original location.

Is there a way to delete the entire rows for the first duplicate entries?
 
Upvote 0
This does work in duplicating the data without the duplicates, but I then have to clear the initial data and transfer the filtered data into the original location.

Is there a way to delete the entire rows for the first duplicate entries?
See if this does what you want:
VBA Code:
Sub DeleteDupsFromTop2()
'Deletes dups from col B from top down
Dim sn, j As Long
sn = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Value
With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)  'put each row into a dictionary item using second column data which has the dups
        .Item(sn(j, 2)) = Application.Index(sn, j, 0)
    Next
    'Write edited (dup free in col A) list back to cols A:E
    Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Clear
    Range("A2").Cells(1, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
    Range("A1").CurrentRegion.Sort key1:=[A2], order1:=xlAscending, Header:=xlYes
End With
End Sub
 
Upvote 1
Solution
Another option...
VBA Code:
Option Explicit
Sub Keep_Last_Duplicate()
    Dim ws As Worksheet, r As Range, LRow As Long, LCol As Long
    Set ws = Worksheets("Sheet1")   '<~~ *** Change sheet name to suit ***
    Set r = ws.Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    LRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    LCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Dim a, b, i As Long
    
    a = ws.Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        If a(i, 1) <> WorksheetFunction.MaxIfs(r.Columns(1), r.Columns(2), a(i, 2)) Then b(i, 1) = 1
    Next i
    ws.Cells(2, LCol).Resize(UBound(b, 1)).Value = b
    
    i = WorksheetFunction.Sum(ws.Columns(LCol))
    If i > 0 Then
        ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
        order1:=xlAscending, Header:=xlNo
        ws.Cells(2, LCol).Resize(i).EntireRow.Delete
    End If
End Sub
 
Upvote 1
Another option...
VBA Code:
Option Explicit
Sub Keep_Last_Duplicate()
    Dim ws As Worksheet, r As Range, LRow As Long, LCol As Long
    Set ws = Worksheets("Sheet1")   '<~~ *** Change sheet name to suit ***
    Set r = ws.Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    LRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    LCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Dim a, b, i As Long
   
    a = ws.Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        If a(i, 1) <> WorksheetFunction.MaxIfs(r.Columns(1), r.Columns(2), a(i, 2)) Then b(i, 1) = 1
    Next i
    ws.Cells(2, LCol).Resize(UBound(b, 1)).Value = b
   
    i = WorksheetFunction.Sum(ws.Columns(LCol))
    If i > 0 Then
        ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
        order1:=xlAscending, Header:=xlNo
        ws.Cells(2, LCol).Resize(i).EntireRow.Delete
    End If
End Sub
Thanks Kevin, this option always works. Appreciate your help
 
Upvote 0
See if this does what you want:
VBA Code:
Sub DeleteDupsFromTop2()
'Deletes dups from col B from top down
Dim sn, j As Long
sn = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Value
With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)  'put each row into a dictionary item using second column data which has the dups
        .Item(sn(j, 2)) = Application.Index(sn, j, 0)
    Next
    'Write edited (dup free in col A) list back to cols A:E
    Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Clear
    Range("A2").Cells(1, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
    Range("A1").CurrentRegion.Sort key1:=[A2], order1:=xlAscending, Header:=xlYes
End With
End Sub
Thanks Joe. This works.
 
Upvote 0

Forum statistics

Threads
1,224,814
Messages
6,181,120
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top