Solved: faster way to delete row

[slamet Harto]

HI there

I have around 60.000 of rows data.
I want to delete row if there is a certain value in multiple column.

Please find the following for reference.

Thanks in advance

Sub DEL_Code()
Dim i As Long, lastrow As Long
Dim Start As Double, Finish As Double

Start = Timer

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
lastrow = Cells.SpecialCells(xlCellTypeLastCell).Row
End With


For i = lastrow To 1 Step -1

If Cells(i, "L").Value <> "00000000" Then
Cells(i, "L").EntireRow.Delete

If Cells(i, "Q").Value <> "00000000" Then
Cells(i, "Q").EntireRow.Delete

If Cells(i, "O").Value <> "1" Or _
Cells(i, "O").Value <> "2" Then
Cells(i, "O").EntireRow.Delete

If UCase(Cells(i, "M").Value) Like "W*" Or _
Cells(i, "M").Value Like "D*" Or _
Cells(i, "M").Value Like "E*" Or _
Cells(i, "M").Value Like "Q*" Or _
Cells(i, "M").Value = "O3" Or _
Cells(i, "M").Value = "O4" Then
Cells(i, "M").EntireRow.Delete

If UCase(Cells(i, "R").Value) Like "W*" Or _
Cells(i, "R").Value Like "D*" Or _
Cells(i, "R").Value Like "E*" Or _
Cells(i, "R").Value Like "Q*" Or _
Cells(i, "R").Value = "O3" Or _
Cells(i, "R").Value = "O4" Then
Cells(i, "R").EntireRow.Delete

End If
Next i



With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

Finish = Timer
MsgBox "Delete Time: " & Finish - Start & " Second"

End Sub

[Tinbendr]

How much of the data is being deleted? More than 50%? Would it be faster to write to data you want to KEEP to a new sheet, then delete/rename the raw data?

[Bob Phillips]

Sub DEL_Code()
Const FORMULA_TEST As String = _
"=OR(L2<>""00000000"",Q2<>""00000000""," & _
"OR(LEFT(M2,1)={""W"",""D"",""E"",""Q""}),OR(M2={""O3"",""O4""})," & _
"OR(LEFT(R2,1)={""W"",""D"",""E"",""Q""}),OR(R2={""O3"",""O4""}))"
Dim i As Long, lastrow As Long
Dim rng As Range
Dim Start As Double, Finish As Double

Start = Timer

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet

lastrow = Cells.SpecialCells(xlCellTypeLastCell).Row

.Columns(20).Insert
.Rows(1).Insert
.Range("T1") = "temp"
.Range("T2").Resize(lastrow).Formula = FORMULA_TEST

Set rng = .Range("T1").Resize(lastrow + 1)
rng.AutoFilter Field:=1, Criteria1:="=TRUE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng Is Nothing Then rng.Delete

.Columns(20).Delete
End With


With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

Finish = Timer
MsgBox "Delete Time: " & Finish - Start & " Second"

End Sub

[slamet Harto]

Hi bob
you did Great trick. it save 2 minutes from 5 minutes.

as always Thanks for assistance

[mdmackillop]

Can you post a small sample of your data?