Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
removing duplicate rows
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 *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
removing duplicate rows
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 "dan graziano" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Removing duplicate rows | New Users to Excel | |||
Removing duplicate rows | Excel Discussion (Misc queries) | |||
removing duplicate rows | Excel Discussion (Misc queries) | |||
removing duplicate rows | Excel Discussion (Misc queries) | |||
Removing Duplicate Rows | Excel Discussion (Misc queries) |