How to remove duplicate rows across several columns without too much loops?

Question

Most questions focus on single column duplicates which is easier and less computationally extensive.

I created a script that will remove duplicate rows across several columns--meaning if all the columns have the exact same values with another row, then it is a duplicate row and should be deleted. The problem is, it is too inefficient due to nested for-next loops. If the workbook has 1200 rows and 7 columns, there will be 1200 x 1200 x 7 runs which will be equal to around 10 million runs. I know arrays will be faster, but I am more concerned about finding a way to reduce the number of loops more.

The code is shown below:

Option Explicit
Function RemoveNonTableDuplicate()
Dim Range_scanned As Range, Range_compared As Range, i As Long, j As Long, x As Long, z As Long, Match As Long, Sheet_name As String, Workbook_name As String, Total_rows As Long

Workbook_name = InputBox("Please Input the Workbook Name", "Identify Workbook Name")
Sheet_name = InputBox("Please Input the Worksheet Name", "Identify Worksheet Name")

Start:
Total_rows = Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Total_rows
    Match = 0
    Set Range_scanned = Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & i & ":E" & i)
    For j = 2 To Total_rows
        Set Range_compared = Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & j & ":E" & j)
        For z = 1 To TotalColumnsCount(Workbooks(Workbook_name).Name, Sheet_name)
            If Range_scanned(z) = Range_compared(z) Then
                x = x + 1
            End If
        Next z
        If x = TotalColumnsCount(Workbooks(Workbook_name).Name, Sheet_name) Then
            Match = Match + 1
        End If
        x = 0
        If Match > 1 Then
            Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & j & ":E" & j).Delete Shift:=xlUp
            GoTo Start
        End If
    Next j
Next i
End Function

To illustrate how the code should work please refer to the images below.

Prior to running the code:

After running the code to remove duplicates:

Why not use Excel's built in feature (Date -> Data Tools - Remove Duplicates)? If you need this in VBA the [`RemoveDuplicates`](https://learn.microsoft.com/en-us/office/vba/api/Excel.Range.RemoveDuplicates) method is what you're looking for — cybernetic.nomad, Mar 13 '19 at 15:59
Possible duplicate of [Remove Duplicates from range of cells in excel vba](https://stackoverflow.com/questions/31631231/remove-duplicates-from-range-of-cells-in-excel-vba) — Samuel Hulla, Mar 13 '19 at 16:02
@cybernetic.nomad Thanks didn't know it could do that over several columns — Pherdindy, Mar 13 '19 at 16:06

score 5 · Accepted Answer · answered Mar 13 '19 at 16:01

5

What stops you from using this?

Range("A:E").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes

answered Mar 13 '19 at 16:01

Daniel

814
6
12

Thanks I never knew such thing existed was looking around lol – Pherdindy Mar 13 '19 at 16:06
Fair enough, glad I helped :P – Daniel Mar 13 '19 at 16:07

How to remove duplicate rows across several columns without too much loops?

1 Answers1