Delete Dupes Macro - Error When No Dupes

JADownie

Active Member
Joined
Dec 11, 2007
Messages
359
Hi -

I have the below macro that I have been using, and it works perfect to flag and remove duplicates. But when there are no duplicates found on the sheet, I get an error at the line below in red.

I am not sure how I would revise this to account for a scenario when there are no duplicates to remove, and I was hoping that someone might be able to assist me here today.

Thank You SO much in advance!!


Sub G_Delete_Dupes_From_Main()


Dim toDel(), I As Long
Dim RNG As Range, Cell As Long
Set RNG = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)


For Cell = 1 To RNG.Cells.Count
If Application.CountIf(RNG, RNG(Cell)) > 1 Then
ReDim Preserve toDel(I)
toDel(I) = RNG(Cell).Address
I = I + 1
End If
Next
For I = UBound(toDel) To LBound(toDel) Step -1
Range(toDel(I)).EntireRow.Delete

Next I

End Sub
 

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,059
Office Version
  1. 2013
Platform
  1. Windows
JAD,

Maybe try...

Code:
Sub G_Delete_Dupes_From_Main()

Dim toDel(), I As Long
Dim RNG As Range, Cell As Long
Set RNG = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)




For Cell = 1 To RNG.Cells.Count
If Application.CountIf(RNG, RNG(Cell)) > 1 Then
ReDim Preserve toDel(I)
toDel(I) = RNG(Cell).Address
I = I + 1
End If
Next


If I > 0 Then
For I = UBound(toDel) To LBound(toDel) Step -1
Range(toDel(I)).EntireRow.Delete
Next I
End If


End Sub

Hope that helps.
 

WarPigl3t

Well-known Member
Joined
May 25, 2014
Messages
1,609
I don't understand the full extent of your code. I understand some of it. I got lost with all the variables. Here's some code that doeswhat you want.
Code:
[COLOR=#333333]Sub G_Delete_Dupes_From_Main()[/COLOR]
firstRow = 2
lastRow = Range("B" & Rows.Count).End(xlup).Row
i = firstRow
Do Until i > lastRow
     ii = i + 1
     Do Until ii > lastRow
          If Range("B" & i).value = Range("B" & ii).value Then
               Rows(ii).Delete
               ii = ii- 1
               lastRow = Range("B" & Rows.Count).End(xlup).Row
          End If
          ii = ii + 1
     Loop
     i = i + 1
Loop
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,109,202
Messages
5,527,388
Members
409,759
Latest member
KCH

This Week's Hot Topics

Top