# VBA to Remove Older Duplicates based on Two Columns



## Bamh1 (Jan 4, 2023)

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 (Jan 5, 2023)

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 (Jan 5, 2023)

```
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 (Jan 5, 2023)

@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.xlsmAB1Product NumberProduct Name22Apple35Orange47Tomato58Potato69Banana713Pineapple815Watermelon916Mango1017Cucumber1118Peach1219Pear132OrangeData

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.xlsmAB1Product NumberProduct Name21Apple32Apple43Banana54Orange65Orange76Cucumber87Tomato98Potato109Banana1110Mango1211Peach1312Pineapple1413Pineapple1514Watermelon1615Watermelon1716Mango1817Cucumber1918Peach2019Pear2120OrangeData


----------



## shinigamilight (Jan 5, 2023)

Alex Blakenburg said:


> @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.xlsmAB1Product NumberProduct Name22Apple35Orange47Tomato58Potato69Banana713Pineapple815Watermelon916Mango1017Cucumber1118Peach1219Pear132OrangeData
> ...




```
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 (Jan 5, 2023)

bebo021999 said:


> May be:
> 
> ```
> Option Explicit
> ...


It works. Thank you very much.


----------



## Bamh1 (Jan 5, 2023)

shinigamilight said:


> ```
> Sub bye_reloaded()
> Dim store As String
> Dim k, i As Integer
> ...


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)


----------

