VBA to check two columns for duplicate values

[theishv]

Hello!

I would appreciate help with some VBA code.
The code has to check two columns for duplicate values. both the values in the same row of the columns has to match the values in a row somewhere else in the columns. When such a match is found the bottom most row should be deleted.


To illustrate this i have made an example, in the picture below row 9 should be deleted.

Thank you.

 

[Fluff]

Hi & welcome to the board.

Which 2 columns do you want to check & what row does the data start in?

 

[theishv]

Hi and thank you.

The columns i want to check are D and E. Te data starts from row 1.

 

[Fluff]

In that case try this

Sub DeleteDupes()

   Dim Cl As Range
   Dim ValU As String
   Dim Rng As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("D1", Range("D" & Rows.Count).End(xlUp))
         ValU = Cl.Value & Cl.Offset(, 1).Value
         If Not .exists(ValU) Then
            .Add ValU, Nothing
         Else
            If Rng Is Nothing Then
               Set Rng = Cl
            Else
               Set Rng = Union(Rng, Cl)
            End If
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete

End Sub

This will work on the active sheet

 

[theishv]

In that case try this

Sub DeleteDupes()

   Dim Cl As Range
   Dim ValU As String
   Dim Rng As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("D1", Range("D" & Rows.Count).End(xlUp))
         ValU = Cl.Value & Cl.Offset(, 1).Value
         If Not .exists(ValU) Then
            .Add ValU, Nothing
         Else
            If Rng Is Nothing Then
               Set Rng = Cl
            Else
               Set Rng = Union(Rng, Cl)
            End If
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete

End Sub

This will work on the active sheet

Thank you very much!

 

[Fluff]

Your welcome