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