Run-time error 6

[Sammy]

Gretings,
As part of a routine to create worksheets the following macro looks at
a list and deletes any duplicates.
The routine works great unless there is only one cell occupied in
which case I get a "Run-time error "6" overflow. Is there any way of
resolving this short of starting again. As you may have guessed my VB
skills are lacking - this code was lifted off one of the posts here
but has served me well thus far.

Sub DeleteDuplicates()
Dim X, C, xMax, y As Integer
Dim S As String
Range("A1").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
X = Selection.Cells(1).Row
xMax = Selection.Cells(Selection.Cells.Count).Row
C = Selection.Cells(1).Column
Do While X < xMax
S = ActiveSheet.Cells(X, C).Value
y = X + 1
Do While y <= xMax
If ActiveSheet.Cells(y, C).Value = S Then
ActiveSheet.Cells(y, C).Delete
xMax = xMax - 1
y = y - 1
End If
'error occurs in the following line
y = y + 1
Loop
X = X + 1
Loop
Range("A1").Select
End Sub

 

[Dave Peterson]

Try dimming Y as Long

Dim Y as Long

You may want to see a couple of other ideas for deleting duplicates.

Chip Pearson has some techniques at:
http://www.cpearson.com/excel/duplicat.htm

(one method that makes it a bit easier to keep track of is to start at the
bottom and work up--then you don't have to fiddle with "is the row gone or did I
just drop to the next row" stuff.)

 

[mudraker]

Try these modification


change
y as integer
to
y as long


Insert additional Code at start to test row number


If Range("A" & Rows.Count).End(xlUp).Row = 1 Then
Exit Sub
End If






Sub DeleteDuplicates()
Dim X, C, xMax, y As Long
Dim S As String

If Range("A" & Rows.Count).End(xlUp).Row = 1 Then
Exit Sub
End If
Range("A1").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
X = Selection.Cells(1).Row
xMax = Selection.Cells(Selection.Cells.Count).Row
C = Selection.Cells(1).Column
Do While X < xMax
S = ActiveSheet.Cells(X, C).Value
y = X + 1
Do While y <= xMax
If ActiveSheet.Cells(y, C).Value = S Then
ActiveSheet.Cells(y, C).Delete
xMax = xMax - 1
y = y - 1
End If
y = y + 1
Loop
X = X + 1
Loop
Range("A1").Select
End Su

 

[Sammy]

Hi Dave
I gave it a try but got an error message "Compile Error - Duplicate
declaration in current scope" caused I presume by the earlier
statement - " Dim X, C, xMax, Y As Integer"
I'll give the link you gave me a try.

Thanks for replying,

Sammy

 

[Sammy]

Mudraker
It worked - thank you.

Sammy

 

[Dave Peterson]

Yep. You'll want to remove that Y portion.

Here's one way to delete duplicates. It starts at the bottom and goes up the
column.

Option Explicit
Sub DeleteDuplicates()
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

With ActiveSheet
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
.Rows(iRow).Delete 'delete the entire row???
'.Cells(iRow, "A").Delete shift:=xlUp 'or just one cell??
End If
Next iRow
End With
End Sub

If you wanted to work from the top to the bottom, you could have your code
essentially click on the first cell to delete, then controlclick on each
subsequent cell to delete. Then delete them in one fell swoop.

Option Explicit
Sub DeleteDuplicates1()

Dim DelRng As Range
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

With ActiveSheet
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow - 1
If .Cells(iRow, "A").Value = .Cells(iRow + 1, "A").Value Then
If DelRng Is Nothing Then
Set DelRng = .Cells(iRow + 1, "A")
Else
Set DelRng = Union(DelRng, .Cells(iRow + 1, "A"))
End If
End If
Next iRow

If DelRng Is Nothing Then
'no duplicates--do nothing
Else
DelRng.EntireRow.Delete
End If

End With
End Sub

Chip Pearson has routines like this at that site.