Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete repeated rows
Hi there,
I have the code below in a sheet, deleting rows that match each other. My problem is that this is very slow to run given that it needs to search & to delete loads of rows. Any ideas out there that could speed this up? Sub DeleteRepeats() Worksheets("Rearranged").Range("h2").Sort _ Key1:=Worksheets("Rearranged").Range("h2") Do Set currentCell = Worksheets("Rearranged").Range("h2") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If nextCell.Value = currentCell.Value Then currentCell.EntireRow.Delete End If Set currentCell = nextCell Loop Loop Until nextCell = 0 End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete repeated rows
SiouxieQ,
I have found through much trial and error that the very fastest way to do this is to: 1) Develop a formula that will evaluate each row, and let's say, place a one in rows to keep and a zero in rows to delete. Copy this formula to all rows in the sheet. 2) Convert the formulas created in step 1 to values. 3) Sort the sheet on the column in which the formula results reside so that all one's and zero's are together. 4) Use FIND to locate the first and last row containing the zero's, then select them and delete them all in one cluster. This method may be a bit more code intensive, but it reduced one of my jobs from over an hour to seconds (literally). Hope this helps. "SiouxieQ" wrote: Hi there, I have the code below in a sheet, deleting rows that match each other. My problem is that this is very slow to run given that it needs to search & to delete loads of rows. Any ideas out there that could speed this up? Sub DeleteRepeats() Worksheets("Rearranged").Range("h2").Sort _ Key1:=Worksheets("Rearranged").Range("h2") Do Set currentCell = Worksheets("Rearranged").Range("h2") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If nextCell.Value = currentCell.Value Then currentCell.EntireRow.Delete End If Set currentCell = nextCell Loop Loop Until nextCell = 0 End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete repeated rows
SiouxieQ,
Try the macro below. HTH, Bernie MS Excel MVP Sub DeleteRepeats2() Dim myRow As Long Worksheets("Rearranged").Activate myRow = Range("H65536").End(xlUp).Row Range("I1").EntireColumn.Insert Range("I1").Value = "Flag" Range("I2").Formula = _ "=IF(COUNTIF(H2:H" & myRow & ",H2)1,""Delete"","""")" Range("I2").AutoFill Destination:=Range("I2:I" & myRow) With Range("I:I") .AutoFilter Field:=1, Criteria1:="Delete" .SpecialCells(xlCellTypeVisible).EntireRow.Delete .EntireColumn.Delete End With End Sub "SiouxieQ" wrote in message ... Hi there, I have the code below in a sheet, deleting rows that match each other. My problem is that this is very slow to run given that it needs to search & to delete loads of rows. Any ideas out there that could speed this up? Sub DeleteRepeats() Worksheets("Rearranged").Range("h2").Sort _ Key1:=Worksheets("Rearranged").Range("h2") Do Set currentCell = Worksheets("Rearranged").Range("h2") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If nextCell.Value = currentCell.Value Then currentCell.EntireRow.Delete End If Set currentCell = nextCell Loop Loop Until nextCell = 0 End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete repeated rows
SiouxieQ,
Here's a better version, that turns off screenupdating and events, and sorts prior to deletion, to speed thing up. HTH, Bernie MS Excel MVP Sub DeleteRepeats2() Dim myRow As Long With Application .ScreenUpdating = False .EnableEvents = False End With myRow = Range("H65536").End(xlUp).Row Range("I1").EntireColumn.Insert Range("I1").Value = "Flag" Range("I2").Formula = _ "=IF(COUNTIF(H2:H" & myRow & ",H2)1,""Delete"","""")" Range("I2").AutoFill Destination:=Range("I2:I" & myRow) Cells.Sort key1:=Range("I2"), order1:=xlDescending, Header:=xlYes With Range("I:I") .AutoFilter Field:=1, Criteria1:="Delete" .SpecialCells(xlCellTypeVisible).EntireRow.Delete .EntireColumn.Delete End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub "SiouxieQ" wrote in message ... Hi there, I have the code below in a sheet, deleting rows that match each other. My problem is that this is very slow to run given that it needs to search & to delete loads of rows. Any ideas out there that could speed this up? Sub DeleteRepeats() Worksheets("Rearranged").Range("h2").Sort _ Key1:=Worksheets("Rearranged").Range("h2") Do Set currentCell = Worksheets("Rearranged").Range("h2") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If nextCell.Value = currentCell.Value Then currentCell.EntireRow.Delete End If Set currentCell = nextCell Loop Loop Until nextCell = 0 End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Delete Repeated Data? | Excel Discussion (Misc queries) | |||
how to delete repeated character in the coloums or rows | Excel Discussion (Misc queries) | |||
Delete in row C if it is repeated in row D | Excel Worksheet Functions | |||
Delete repeated Cells | Excel Worksheet Functions | |||
delete repeated numbers | Excel Worksheet Functions |