Speed up VBA code to delete rows

[LWell]

Hi all,

I have a spreadsheet that has nearly 50,000 rows. In column J of this sheet, values are either "TRUE" or "FALSE." I am trying to delete every row in which the cell in column J is "FALSE." The following code works but it takes over three minutes to compile.

Sub Delete_Rows()
 Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long


    Set ws = ActiveWorkbook.Sheets("Sheet1")


    lastRow = ws.Range("J" & ws.Rows.Count).End(xlUp).Row


    Set rng = ws.Range("J1:J" & lastRow)


    With rng
        .AutoFilter Field:=1, Criteria1:="FALSE"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With


    ws.AutoFilterMode = False
    
End Sub

I figured AutoFiltering would be quicker than looping but it is still taking way too long. Am I stuck here so is there a faster method? Thanks for the help!

 

[deletedalien]

Considering that your delete criteria is "false" you more than likely have formulas in there and excel might be calculating the formulas over and over while deleting the rows,

have you considered:

Application.Calculation = xlCalculationManual

Also

Application.ScreenUpdating = False

and then

Application.Calculation = xlCalculationAutomatic



Application.ScreenUpdating = true


HTH

 

[petertenthije]

I hope you don't mind that I write down the steps instead of the code. For the moment I am stuck using a Dutch version of excel. Just follow these steps while recording your macro. I would recommend (temporarily) disabling the auto calculation. Make that a part of the macro coding as well as explained earlier by deletedalien.

STEP 1: replace the FALSE status with error messages. This is easiest done with a formula like =IF(A1=FALSE;NA() ;A1).
STEP 2: calculate the formulas
STEP 3: remove the formulas by copying and pasting as values
STEP 4: select the error messages. This is done quickly with the "go-to special" screen (shortcut ctrl-g). Select "constants" and tick the "errors" box.
STEP 5: remove the selected rows

note that step 5 only works if there is an error message. Otherwise your macro may freeze. So between step 1 and 2 you might want to add a dummy error code =NA() below your last line with data. For this you can use the offset formula.

 

[MARK858]

See if the below code is any quicker

Sub DelUNION()
    Dim rFnd As Range, dRng As Range, rFst As String

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

    With Sheets("Sheet1").Range("J2:J" & Sheets("Sheet1").Range("J" & Rows.Count).End(xlUp).Row)
        Set rFnd = .Find(what:="FALSE", _
                         LookIn:=xlValues, _
                         lookat:=xlWhole, _
                         SearchOrder:=xlByRows, _
                         SearchDirection:=xlNext, _
                         MatchCase:=True)

        If Not rFnd Is Nothing Then

            rFst = rFnd.Address
            Do
                If dRng Is Nothing Then
                    Set dRng = Sheets("Sheet1").Range("A" & rFnd.Row)
                Else
                    Set dRng = Union(dRng, Sheets("Sheet1").Range("A" & rFnd.Row))
                End If

                Set rFnd = .FindNext(After:=rFnd)

            Loop Until rFnd.Address = rFst
        End If

        Set rFnd = Nothing
    End With


    If Not dRng Is Nothing Then dRng.EntireRow.Delete

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

End Sub

 

[MARK858]

Another one to try as long as you don't have any errors in column J

Sub DeleteJ()
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    Columns("J").Replace "FALSE", "#N/A", xlWhole
    On Error Resume Next
    Columns("J").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
    On Error GoTo 0

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

 

[LWell]

Thank you all for your helpful suggestions. They each work in their own right but they are still a little slow for what I am trying to do. What I'm considering doing is changing "TRUE" and "FALSE" to "1" and "0". I will then sort from largest to smallest by row J. After that look in column J for the first 0, select that entire row and every row below it and "clear" rather than delete the whole row. Do you guys think this will work? I can try to whip up some code and report back.

 

[LWell]

Got it running well using my method described above. For posterity purposes, here is the code:

Sub Delete_Rows()
Dim x As Integer
Columns("J:J").Select
    Range("J2").Activate
    Selection.Find(What:="0", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
        :=True, SearchFormat:=False).Activate
x = ActiveCell.Row
With Sheets("Sheet1")
    .Rows(x & ":" & .Rows.Count).ClearContents
End With
End Sub