Deleting rows with values based on a column

Question

I have a monthly base with almost 373,000 lines. Of these, part has a low value or is blank. I\'d like to erase this lines.

I have part of this code to delete those

Answer 1

There's apparently an argument to be made, that deleting rows as you find them would be faster than deleting them all at once.

So I ran the below code with 36000 rows of =RANDBETWEEN(0, 10) in columns A and B (and then copy+paste special/values), and it completed thrice in 32 seconds and dusts.

Uncommenting the currentValue assignment and replacing the array subscript accesses with currentValue comparisons adds 2.5 seconds overhead; uncommenting the IsError check adds another 3.5 seconds overhead - but then the code won't blow up if the checked cells have the slightest chance of containing some #REF! or #VALUE! error.

Every time I ran it, ~4000 rows ended up being deleted.

Note:

• No implicit ActiveSheet references. The code works against Sheet2, which is the code name for Worksheets("Sheet2") - a globally scoped Worksheet object variable that you get for free for any worksheet that exists at compile-time. If the sheet you're running this against exists at compile-time, use its code name (that's the (Name) property in the Properties toolwindow / F4).
• Range is hard-coded. You already know how to get the last row with data, so I didn't bother with that. You'll want to dump your working range in a variant array nonetheless.
• The commented-out code can be ignored/deleted if there's no way any of the cells involved have any chance of ever containing a worksheet error value.

Public Sub SpeedyConditionalDelete()

    Dim startTime As Single
    startTime = Timer

    '1. dump the contents into a 2D variant array
    Dim contents As Variant
    contents = Sheet2.Range("A1:B36000").Value2

    '2. declare your to-be-deleted range
    Dim target As Range

    '3. iterate the array
    Dim i As Long
    For i = LBound(contents, 1) To UBound(contents, 1)

        '4. get the interesting current value
        'Dim currentValue As Variant
        'currentValue = contents(i, 1)

        '5. validate that the value is usable
        'If Not IsError(currentValue) Then

            '6. determine if that row is up for deletion
            If contents(i, 1) = 0 Or contents(i, 1) = vbNullString Then

                '7. append to target range
                If target Is Nothing Then
                    Set target = Sheet2.Cells(i, 1)
                Else
                    Set target = Union(target, Sheet2.Cells(i, 1))
                End If

            End If

        'End If

    Next

    '8. delete the target
    If Not target Is Nothing Then target.EntireRow.Delete

    '9. output timer
    Debug.Print Timer - startTime

End Sub

Of course 375K rows will run much longer than 32-38 seconds, but I can't think of a faster solution.

Answer 2

I am concerned about the 375K lines, who knows how long this will take to run.

    Sub Button1_Click()

    Dim i As Long
    For i = Cells(Rows.Count, "D").End(xlUp).Row To 2 Step -1
        If Cells(i, "D") = 0 Or Cells(i, "D") = "" Then
            Rows(i).Delete
        End If
    Next i


End Sub

I'm curious to know if this works for others, it just uses the "replace" 0 values to blanks, then uses specialcells to delete the blank rows. My test of 38K rows takes 3 seconds.

    Sub FindLoop()

    Dim startTime As Single
    startTime = Timer


    '--------------------------


    Columns("D:D").Replace What:="0", Replacement:="", LookAt:=xlPart, _
                           SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
                           ReplaceFormat:=False
    Columns("D:D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete



    '---------------------------------
    Debug.Print Timer - startTime
End Sub

Answer 3

How about:

Sub ZeroKiller()
    Dim N As Long, ToBeKilled As Range
    Dim i As Long

    N = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To N
        If Cells(i, "D").Value = 0 Or Cells(i, "D").Value = "" Then
            If ToBeKilled Is Nothing Then
                Set ToBeKilled = Cells(i, "D")
            Else
                Set ToBeKilled = Union(ToBeKilled, Cells(i, "D"))
            End If
        End If
    Next i

    If Not ToBeKilled Is Nothing Then
        ToBeKilled.EntireRow.Delete
    End If
End Sub

This assumes that A is the longest column. If this is not always the case, use:

N = Range("A1").CurrentRegion.Rows.Count