VBA to Remove Older Duplicates based on Two Columns

[Bamh1]

Hello,

I have a list of products that have duplicates which have to be removed. These products correspond to serial numbers. Lower serial numbers show older products. The duplicate version that needs to be removed is the older 1. In the attached example image, we have two apples in cells B2 and B3. The older duplicate is B2 which should be removed (Entire row should be removed from the data). Similarly, Orange no 20 should be kept and other duplicates should be removed.

I am working on the following code:

Sub del_older_dups_two_col()
Dim i As Integer
Dim rng1 As Range
Dim rng2 As Range

rng1 = Range("a1:a21)
rng2 = Range("b1:b21")

For i = 1 to 20
If rng2.Cells(i, 1) = rng2.Cells(i + 1, 1) Then ' Here I need to compare each cell to the entire cells in the range
rng1.Cells(i, j).EntireRow.Delete ' Here I need to set up the condition to remove the older version
End If
Next i
End Sub

Could someone please help me complete this code.

Thank you,

Shawn

 

[bebo021999]

May be:

Option Explicit
Sub DeleteDup()
Dim lr&, i&, cell As Range, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = lr To 1 Step -1
    If Not dic.exists(Cells(i, 2).Value) Then
        dic.Add Cells(i, 2).Value, ""
    Else
        Rows(i).Delete
    End If
Next
End Sub

 

[shinigamilight]

Sub bye()
        Dim store As String
        Dim k As Integer
        Dim dic As New Scripting.Dictionary
        Dim lr As Long
        lr = Range("A1").End(xlDown).Row
        
        For k = lr To 2 Step -1
                store = Range("B" & k)
                If dic.Exists(store) = False Then
                    dic(store) = Range("A" & k)
                
                ElseIf dic(store) > Range("A" & k) Then
                           Range("A" & k).EntireRow.Delete
                ElseIf dic(store) < Range("A" & k) Then
                           dic(store) = Range("A" & k)
                End If
                
        Next k
        
        
        
End Sub

 

[Alex Blakenburg]

@shinigamilight, that doesn't really work. The only reason to store and check column A is if you think that the Product Number column is not going to be in order.
If that is the case then in your last condition you would need to not only swap the dictionary last value held but also delete the one you are swapping out but since the code is not storing the row number it won't be able to delete the row being swapped out.
eg I changed the last Orange from 20 to 2 and finished up with the below.

20230105 VBA Delete Previous versions Bamh1.xlsm
	A	B
1	Product Number	Product Name
2	2	Apple
3	5	Orange
4	7	Tomato
5	8	Potato
6	9	Banana
7	13	Pineapple
8	15	Watermelon
9	16	Mango
10	17	Cucumber
11	18	Peach
12	19	Pear
13	2	Orange
Data

Just for completeness here an XL2BB of the starting point:
(without the change of Orange from 20 to 2)

20230105 VBA Delete Previous versions Bamh1.xlsm
	A	B
1	Product Number	Product Name
2	1	Apple
3	2	Apple
4	3	Banana
5	4	Orange
6	5	Orange
7	6	Cucumber
8	7	Tomato
9	8	Potato
10	9	Banana
11	10	Mango
12	11	Peach
13	12	Pineapple
14	13	Pineapple
15	14	Watermelon
16	15	Watermelon
17	16	Mango
18	17	Cucumber
19	18	Peach
20	19	Pear
21	20	Orange
Data

 

[shinigamilight]

@shinigamilight, that doesn't really work. The only reason to store and check column A is if you think that the Product Number column is not going to be in order.
If that is the case then in your last condition you would need to not only swap the dictionary last value held but also delete the one you are swapping out but since the code is not storing the row number it won't be able to delete the row being swapped out.
eg I changed the last Orange from 20 to 2 and finished up with the below.

20230105 VBA Delete Previous versions Bamh1.xlsm
	A	B
1	Product Number	Product Name
2	2	Apple
3	5	Orange
4	7	Tomato
5	8	Potato
6	9	Banana
7	13	Pineapple
8	15	Watermelon
9	16	Mango
10	17	Cucumber
11	18	Peach
12	19	Pear
13	2	Orange
Data

Just for completeness here an XL2BB of the starting point:
(without the change of Orange from 20 to 2)

20230105 VBA Delete Previous versions Bamh1.xlsm
	A	B
1	Product Number	Product Name
2	1	Apple
3	2	Apple
4	3	Banana
5	4	Orange
6	5	Orange
7	6	Cucumber
8	7	Tomato
9	8	Potato
10	9	Banana
11	10	Mango
12	11	Peach
13	12	Pineapple
14	13	Pineapple
15	14	Watermelon
16	15	Watermelon
17	16	Mango
18	17	Cucumber
19	18	Peach
20	19	Pear
21	20	Orange
Data

Sub bye_reloaded()
        Dim store As String
        Dim k, i As Integer
        Dim dic As New Scripting.Dictionary
        Dim lr As Long
        Dim ADD1, ADD2 As Integer
        lr = Range("A1").End(xlDown).Row
       
        For k = lr To 2 Step -1
                store = Range("B" & k)
                If dic.Exists(store) = False Then
                    dic(store) = Range("A" & k)
                        For i = k - 1 To 2 Step -1
                                If dic.Exists(Range("B" & i).Value) Then
                                If Range("A" & i) < dic(store) Then
                                    Range("A" & i).EntireRow.Delete
                                    ADD1 = ADD1 + 1
                                ElseIf Range("A" & i) > dic(store) Then
                                    Range("A" & k).EntireRow.Delete
                                    dic(store) = Range("A" & i)
                                    ADD2 = ADD2 + 1
                                End If
                                End If
                        Next i
                 End If
                       
        k = k - ADD1 - ADD2
        ADD1 = 0
        ADD2 = 0
        Next k
       
       
       
End Sub

This will work for even random serial numbers.

 

[Bamh1]

May be:

Option Explicit
Sub DeleteDup()
Dim lr&, i&, cell As Range, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = lr To 1 Step -1
    If Not dic.exists(Cells(i, 2).Value) Then
        dic.Add Cells(i, 2).Value, ""
    Else
        Rows(i).Delete
    End If
Next
End Sub

It works. Thank you very much.

 

[Bamh1]

Sub bye_reloaded()
        Dim store As String
        Dim k, i As Integer
        Dim dic As New Scripting.Dictionary
        Dim lr As Long
        Dim ADD1, ADD2 As Integer
        lr = Range("A1").End(xlDown).Row
      
        For k = lr To 2 Step -1
                store = Range("B" & k)
                If dic.Exists(store) = False Then
                    dic(store) = Range("A" & k)
                        For i = k - 1 To 2 Step -1
                                If dic.Exists(Range("B" & i).Value) Then
                                If Range("A" & i) < dic(store) Then
                                    Range("A" & i).EntireRow.Delete
                                    ADD1 = ADD1 + 1
                                ElseIf Range("A" & i) > dic(store) Then
                                    Range("A" & k).EntireRow.Delete
                                    dic(store) = Range("A" & i)
                                    ADD2 = ADD2 + 1
                                End If
                                End If
                        Next i
                 End If
                      
        k = k - ADD1 - ADD2
        ADD1 = 0
        ADD2 = 0
        Next k
      
      
      
End Sub

This will work for even random serial numbers.

Thank you both for helping out. I tried running this code, but it gives a compile error. It has an issue with the declaration of scripting.dictionary (user defined type not defined)