Delete duplicate for multiple columns using a macro in an excel report
This code helps me to delete duplicate based on multiple criteria, for instance, if column A, B, C have the same values, delete them. I will show different codes including one deleting from the below and one deleting from the top. For delete duplicate on single column, check my article Delete entire rows that contain duplicate incident ticket numbers using a macro in an excel report.
When I use the macro ?
To delete cells or rows containing multiple duplicates.
How to create the macro ?
Read How to create, edit, hide and select a macro in an excel report
How to create the button to associate it with the macro ?
Read How to create a button and associated it to a macro in an excel report
How is/are the macro(s) ?
Copy the code below and paste it into your macro. You will see my comments in green if exist so follow the help to adapt to your need.
Sub test() ' change A1:E10 by your full range, if you don´t put full range i.e. A1:C10, it will delete only columns defined in your array ' change Array(1, 2, 3) by your ID columns to check duplicate, i.e. column A = 1, column B = 2, etc. ' if not including header, replace xlYes by xlNo Range("A1:E10").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes End Sub
The same one as above except for a table:
Sub test() ' change table1 by your table ' change Array(1, 2, 3) by your ID columns to check duplicate, i.e. column A = 1, column B = 2, etc. ' if not including header, replace xlYes by xlNo ActiveSheet.ListObjects("Table1").DataBodyRange.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes End Sub
NOTE: the 2 solutions above may not work properly with hugh data to delete, if it is the case, I use one of the following solutions. This one deleting the entire row from the below (not working for table):
Sub test() Dim rng As Range Dim duprng As Range ' change A1:C10 by your range to check duplicate, header row to be included Set rng = Range("A1:C10") rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True Set duprng = Nothing For Each Row In rng.Rows If Row.EntireRow.Hidden Then If duprng Is Nothing Then Set duprng = Row Else Set duprng = Union(duprng, Row) End If End If Next If Not duprng Is Nothing Then duprng.EntireRow.Delete ActiveSheet.ShowAllData End Sub
This one deleting the entire row from the top:
Sub test() Dim rng As Range Dim rdel As Range Dim i As Long Dim dict Dim j ' change A1:C10 by your range to check duplicate, header row to be included Set rng = Range("A1:C10") Set dict = CreateObject("scripting.dictionary") For i = rng.Rows.Count To 1 Step -1 Set rdel = rng.Rows(i) j = Join(Application.Transpose(Application.Transpose(rdel.Value)), "~~") If dict.exists(j) Then rdel.EntireRow.Delete dict(j) = True Next i End Sub
Interesting Topics
-
Be successfully certified ITIL 4 Managing Professional
Study, study and study, I couldn’t be successfully certified without studying it, if you are interested...
-
Be successfully certified ITIL 4 Strategic Leader
With my ITIL 4 Managing Professional certification (ITIL MP) in the pocket, it was time to go for the...
-
Hide visual and change background color based on selection
Some small tricks to customize the background colour of a text box...
-
Stacked and clustered column chart or double stacked column chart
In excel, I use a lot the combination of clustered and stacked chart...