Delete Dupes Macro - Error When No Dupes

[JADownie]

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

 

[Snakehips]

JAD,

Maybe try...

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]

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.

[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