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