VBA to delete duplicates

[VbaHell]

Hello all

I am trying to delete all the duplicate rows base on the values in column "A"

The rows are dynamic as in the number of rows and the code below will not work

If I manually select the range and use Data - Remove duplicates it works fine but if I record this it will not work

Any ideas please

 Range("A1:Z50000").Select
Range("A1:Z50000").RemoveDuplicates Columns:=Array(1), Header:=xlNo

 

[VbaHell]

Thank you Fluff this works well

 

[Fluff]

You're welcome

 

[Peter_SSs]

If I manually select the range and use Data - Remove duplicates it works fine but if I record this it will not work

Any ideas please

 Range("A1:Z50000").Select
Range("A1:Z50000").RemoveDuplicates Columns:=Array(1), Header:=xlNo

If your data is anything like this size, you should find this code much faster. It depends not only on the number of rows of data but also the number of disjoint row ranges that need to be deleted, but with 10,000 rows of data (where about one quarter of the rows needed to re removed) this code took 0.06 seconds whereas the previous code took 8.9 seconds.

One other, possibly minor, point is that without the dictionary CompareMode set, Fluff's code is case-sensitive whereas Remove Duplicates & the code below are not.

Sub Del_Dupes()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      b(i, 1) = 1
      k = k + 1
    Else
      d(a(i, 1)) = Null
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub