removing duplicate rows

[dan graziano]

I found this VB code for removing duplicate rows, and it seems to be
working well. But for larger datasets, I get an overflow error when I
run it. Does anyone know of another, more efficient code which does the
same thing?

Sub noduplicationrows()

Dim x, looper, loopy As Integer
Dim sheetData As Variant
Dim strConcat As String
Dim deleteRows() As Integer
Dim value As Integer
x = 0

'first assign the sheet data to an array
sheetData = ActiveSheet.UsedRange
'now check each value with all the further values and delete the rows
required
For looper = LBound(sheetData, 1) To (UBound(sheetData, 1) - 1)
strConcat = sheetData(looper, 1) & sheetData(looper, 2) &
sheetData(looper, 3) & sheetData(looper, 4) & sheetData(looper, 5) _
& sheetData(looper, 6) & sheetData(looper, 7)
For loopy = (looper + 1) To UBound(sheetData, 1)
If strConcat = sheetData(loopy, 1) & sheetData(loopy, 2) &
sheetData(loopy, 3) & sheetData(loopy, 4) & sheetData(loopy, 5) _
& sheetData(looper, 6) & sheetData(looper, 7) Then
'we need to delete the row so store in array
ReDim Preserve deleteRows(x)
deleteRows(x) = loopy
x = x + 1
End If
Next loopy
Next looper

'we now have array of rows that need deleting but there may be rows that
appear twice
For looper = 0 To (x - 2)
value = deleteRows(looper)
For loopy = (looper + 1) To (x - 1)
If deleteRows(loopy) = value Then deleteRows(loopy) = 0
Next loopy
Next looper


'now delete rows if value greater than 0
For looper = (x - 1) To 0 Step -1
'work backwards to avoid row number changing
If deleteRows(looper) > 0 Then
ActiveSheet.Rows(deleteRows(looper)).Delete
Next looper

Sheets("sheet1").Name = "criteria file"
Sheets("criteria file").Cells.Copy
Worksheets.Add
Sheets("").Cells.Paste
Sheets("sheet2").Name = "criteria only"

End Sub

 

[Jim Cone]

Dan,

It appears that the variables in the code you are using are the wrong data type.

Change the second line: "Dim x, looper, loopy As Integer" to...
Dim x As Long, looper As Long, loopy As Long

Change the fifth line: "Dim deleteRows() As Integer" to...
Dim deleteRows() As Long

Change the sixth line: "Dim value As Integer" to...
Dim value As Long

Regards,
Jim Cone
San Francisco, CA