Remove duplicates in all rows

[JadonR]

I am trying to use a macro to delete all duplicate rows. I found the below in a google search but it definitely does not delete all rows.

Sub Delete_Duplicate_Rows_Based_on_All_Columns()
Dim MyRng As Range
Dim MainColumns As Variant
Set MyRng = Range("A2:C1000")
AllColumns = MyRng.Columns.Count
ReDim MainColumns(0 To AllColumns - 1)
For i = 0 To AllColumns - 1
MainColumns(i) = i + 1
Next i
MyRng.RemoveDuplicates Columns:=(MainColumns), Header:=xlYes
End Sub

For example, I have the below table and there are quite a lot of duplicates.

A	B	C
ITEM_NO	DIM_2_UPPER	DIM_2
38518	S	S
38518	M	M
38518	L	L
38518	XL	XL
38518	XXL	XXL
38518	S	S
38518	S	S
38518	M	M
38518	L	L
38518	XL	XL
38504	XXL	XXL
38504	S	S
38504	M	M
38504	L	L
38504	XL	XL
38504	XXL	XXL
38504	S	S
38504	M	M
38504	L	L
38504	XL	XL
38504	XXL	XXL
38504	XS	XS
38504	S	S
38504	M	M
38504	L	L

 

[DanteAmor]

Hi @JadonR, Thanks for posting on the forum.

Try this:

Sub Delete_Duplicate_Rows_Based_on_All_Columns()
  Dim dic As Object
  Dim rng As Range
  Dim i As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set rng = Range("A2:C" & Range("A" & Rows.Count).End(3).Row)
  For i = 1 To rng.Columns.Count
    dic(i) = i
  Next i
  rng.RemoveDuplicates Columns:=dic.keys, Header:=xlYes
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

 

[JadonR]

When I run it, some duplicate rows are removed but most are left. But then I realized that part of the reason is because each of these cells are pulling data from a vlookup.

So I copied and pasted the data into a new sheet and chose to paste values only. When I ran it again, it missed row 8. I believe this is because this value was duplicated 3 times instead of just two.

A	B	C
ITEM_NO	DIM_2_UPPER	DIM_2
38518	S	S
38518	M	M
38518	L	L
38518	XL	XL
38518	XXL	XXL
38518	S	S
38504	S	S
38504	M	M
38504	L	L
38504	XL	XL
38504	XXL	XXL

Can you modify the macro to remove rows where there are more than two duplicates?

 

[JadonR]

Actually, this seems to do it.

Sub Delete_Duplicate_Rows_Based_on_All_Columns()

    With ActiveSheet
        Set rng = Range("A1", Range("C1").End(xlDown))
        rng.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    End With

End Sub

Could I just use this?