Excel VBA - Removing duplicates - vba

Question

I try to sort a sheet in my workbook. After the macro sorted my table it should remove all duplicates based on the column A.
But every time I use the macro, I get the following error:
Sub SortAndRemoveDUBS()
Dim Rng As Range
Dim LastRow As Long
Dim i As Long
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Set Rng = Range("A4:P" & LastRow)
With Rng
.Sort Key1:=Range("A4"), Order1:=xlAscending, key2:=Range("P4"), order2:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
Dim arr() As Variant
Dim cnt As Long
cnt = 0
For i = LastRow To 2 Step -1
If WorksheetFunction.CountIf(Range(Cells(2, "A"), Cells(i, "A")), Cells(i, "A")) > 1 Then
ReDim Preserve arr(cnt)
arr(cnt) = i
cnt = cnt + 1
End If
Next i
If Len(Join(arr)) > 0 Then ActiveSheet.Range("A" & Join(arr, ",A")).EntireRow.Delete
Application.ScreenUpdating = True
End Sub
This line gets highlighted:
ActiveSheet.Range("A" & Join(arr, ",A")).EntireRow.Delete
Does someone see what the probleme is?

Answer 1

Use RemoveDuplicates()
and, since you remove all duplicates from column "A" either you sort on column "A" or on column "P": I assume you need this latter
Sub SortAndRemoveDUBS()
With Worksheets("MyDataSheet") '<--| change "MyDataSheet" to your actual worksheet name
With Range("A4:P" & .Cells(.Rows.Count, "B").End(xlUp).Row)
.RemoveDuplicates Columns:=Array(1)
.Sort Key1:=Range("P4"), order1:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
End With
End Sub

Answer 2

If you want to remove all duplicates except the first one then this code will work in 2007+:
Sub SortAndRemoveDUBS()
Dim Rng As Range
Dim LastRow As Long
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Set Rng = Range("A4:P" & LastRow)
With Rng
.Sort Key1:=Range("A4"), Order1:=xlAscending, key2:=Range("P4"), order2:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
Rng.RemoveDuplicates Columns:=1, Header:=xlYes
Application.ScreenUpdating = True
End Sub
Edit:
If you want to remove all duplicates this code will do the job:
Sub SortAndRemoveDUBS()
Dim Rng As Range
Dim LastRow As Long
Dim i As Long
Dim RngToDelete As Range
Application.ScreenUpdating = False
LastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
Set Rng = ThisWorkbook.Worksheets("Sheet1").Range("A4:P" & LastRow)
With Rng
.Sort Key1:=Range("A4"), Order1:=xlAscending, key2:=Range("P4"), order2:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
For i = LastRow To 4 Step -1
If WorksheetFunction.CountIf(.Resize(, 1), .Cells(i - 3, 1)) > 1 Then
If RngToDelete Is Nothing Then
Set RngToDelete = .Cells(i - 3, 1).EntireRow
Else
Set RngToDelete = Union(RngToDelete, .Cells(i - 3, 1).EntireRow)
End If
End If
Next i
End With
If Not RngToDelete Is Nothing Then
RngToDelete.Delete
End If
Application.ScreenUpdating = True
End Sub

Answer 3

Try using Application.WorksheetFunction.Match method
Example
Option Explicit
Sub Function_Match()
Dim vRow As Variant
Dim i As Long, LastRow As Long
LastRow = WorksheetFunction.CountA(Columns(1))
For i = LastRow To 2 Step -1
vRow = Application.Match(Cells(i, 1).Value, Range(Cells(1, 1), Cells(i - 1, 1)), 0)
If Not IsError(vRow) Then
Rows(vRow).Delete
End If
Next
End Sub