Locate a change in Col

[rlee1999]

I have a bit of code that deletes rows that do not match a certain criteria:

For i = Cells(Rows.Count, "D").End(xlUp).Row To 2 Step -1
If Cells(i, "D").Value <> Range("D2").Value Then
Rows(i).Delete
End If
Next i

This works but it takes forever, sometimes has to delete 1500 rows.

I am looking for something that will identify the first row in Col D that
does not match D2 and then offsets to the same row in Col A where I will use
the following:

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp

Any Suggestions?

 

[caroline]

have you tried to switch the calculation to manual before executing your code
and then put it back to automatic?
it generally works and reduce the time dramatically

Sub CalcManual()

With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False

End Sub



Sub CalcAutomatic()
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Calculate

End Sub

 

[rlee1999]

Thank You Caroline!!! Works like a charm!

have you tried to switch the calculation to manual before executing your code
and then put it back to automatic?
it generally works and reduce the time dramatically

Sub CalcManual()

With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False

End Sub



Sub CalcAutomatic()
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Calculate

End Sub