faster and efficient way of deleting rows

Question

what i am trying to do.

I have two worksheets "dashboard" and "temp calc".I am trying to delete rows based on two different conditions in each worksheet.

Dashboard- delete rows if column number 15 <> active

delete rows if column number 10 <> E&D,ESG,PLM SER,VPD,PLM Prod.

Temp calc = Delete rows if column number 6 is blank

delete rows if column number 3n1 where n1 and n2 are dates taken from range("n1" and "n2") in dashboard.

What I have tried.

1. using a for loop
2. using a filter
3. arrays(I am unable to actually do this using an array

My Problem

these methods are very slow and my data is around 1,68,000(grows on a weekly basis).So I am looking for alternatives to what I have tried. Basically something which will do this fast.

my codes I have tried. the below code works but it takes upto 6-10 minutes depending on the data

                    Worksheets("Dashboard").Activate
                    Range("A4").Select
                    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
                    For x = lastrow To 4 Step -1
                     If Cells(x, 15).Value <> "Active" Or (Cells(x, 10).Value <> "E&D" And Cells(x, 10).Value <> "ESG" _
                     And Cells(x, 10).Value <> "PLM SER" And Cells(x, 10).Value <> "VPD" And Cells(x, 10).Value <> "PLM PROD") Then
                    Rows(x).Delete
                    End If
                    Next x

The below code uses the autofilter method.the problem is that data which is not in my compare range is left after filtering(i.e if my n1 =1st Jan and n2=30th jan 2013. the filter will still leave behind data that is not in the n1 and n2 range.

Set ws = ThisWorkbook.Worksheets("Temp Calc")



   '~~> Start Date and End Date
   Sheets("Dashboard").Select
N1 = Range("n1").Value
N2 = Range("n2").Value
Sheets("Temp Calc").Select

With ws

'~~> Remove any filters
.AutoFilterMode = False

'~~> Get the last row
lRow = .Range("A" & .Rows.Count).End(xlUp).Row

'~~> Identify your data range
Set FltrRng = .Range("A1:F" & lRow)

'~~> Filter the data as per your criteria
With FltrRng
'~~> First filter on blanks
.AutoFilter Field:=6, Criteria1:="="

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'~~> Delete the filtered blank rows
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

ws.ShowAllData

'~~> Next filter on Start Date
.AutoFilter Field:=3, Criteria1:="<" & N1, Operator:=xlAnd
'~~> Finally filter on End Date
.AutoFilter Field:=4, Criteria1:=">" & N2, Operator:=xlAnd

'~~> Filter on col 6 for CNF
'.AutoFilter Field:=6, Criteria1:="CNF"

'~~> Delete the filtered rows
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

'~~> Remove any filters
.AutoFilterMode = False
End With

Apologies in case the question is not adequate. Any alternatives which will speed up what I am trying to do is highly appreciated.

Answer 1

Auto filter is fast - definitely the way to go - but it hides data rows and doesn't delete them. Since your code turns the filter off at the end, the hidden rows come back. Instead, you should apply the filter, select all, copy, paste into new sheet, and delete the old sheet. This will be very fast - and do exactly what you are asking for.

Apologies that I am not posting working code - typing on ipad...

Answer 2

Try below code

Sub DeleteRows()

    Dim x As Long
    Dim Rng As Range
    Dim lastRow As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With Sheets("Dashboard")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Rng = .Range("A1:A" & lastRow)


        For x = Rng.Rows.Count To 1 Step -1
            If .Cells(x, 15).Value <> "Active" Or (.Cells(x, 10).Value <> "E&D" And .Cells(x, 10).Value <> "ESG" _
             And .Cells(x, 10).Value <> "PLM SER" And .Cells(x, 10).Value <> "VPD" And .Cells(x, 10).Value <> "PLM PROD") Then
                Rng.Rows(x).Delete
            End If
        Next

    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub