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 that have zero. How to create a code that joins the empty row conditions (column D) in a more agile way.

Thanks

Sub DelRowsZero()

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

End Sub

Possible duplicate of [Excel VBA delete row based on cell](https://stackoverflow.com/questions/42776545/excel-vba-delete-row-based-on-cell) — ashleedawg, Feb 27 '18 at 18:10
@ashleedawg I don't think this is a duplicate of that question. @user1914644 You should include some additional "empty row conditions". Are these "empty row conditions" always the same? Or are they read from a cell somewhere? My first thought is to simply use an OR in your `If` statement, to test if the header value is 0, or if it is < other "empty row conditions" value >, etc. — tehhowch, Feb 27 '18 at 18:12
Hi! The "empty row conditions" would be that in column D (Header Value), if it has a value of 0 or empty, the row would be erase — user1914644, Feb 27 '18 at 18:17
Your sample shows in column D "1,0" is that a condition as well? if the cell contains a "0"? — Davesexcel, Feb 27 '18 at 18:18
`If Cells(i, "D") = 0 or Cells(i, "D") = "" Then Rows(i).Delete`? — BruceWayne, Feb 27 '18 at 18:19
@Davesexcel 1 is just rand number. Probably a bad example. If the cell contains a "0" is a condition to erase the row OR if contains a blank value — user1914644, Feb 27 '18 at 18:23

score 2 · Answer 1 · answered Feb 27 '18 at 18:20

2

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

answered Feb 27 '18 at 18:20

Gary's Student

95,722
10
59
99

Thanks! Gonna test. Actually the column A, B and C are the same, i mean, contains the same number of rows and data – user1914644 Feb 27 '18 at 18:30
I put Application.ScreenUpdating = False, Application.EnableEvents = False and Application.Calculation = xlCalculationManual after the Sub and still processing hahahha – user1914644 Feb 27 '18 at 19:03
1

@user1914644 It will take a long time. – Gary's Student Feb 27 '18 at 19:04
1

@user1914644 then dump the cells into a variant array, and iterate the array instead of accessing the worksheet. Should be pretty much instant then. – Mathieu Guindon Feb 27 '18 at 19:05
@Mat'sMug Thanks for the tip. Gonna search about it – user1914644 Feb 27 '18 at 19:15
@user1914644 okay, not quite instant. 300K rows is *a lot* of data! – Mathieu Guindon Feb 27 '18 at 19:48
@user1914644 BTW I wouldn't expect screen updating / worksheet events / calculation to have any effect whatsoever here - the only instruction that triggers anything in this answer is the conditional `ToBeKilled.EntireRow.Delete` call. – Mathieu Guindon Feb 27 '18 at 19:56
1

Deleting a large number of rows is even faster if sorted first (including the time to sort). – Feb 28 '18 at 01:00

Davesexcel · Answer 2 · 2018-02-28T16:31:58.610

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

edited Feb 28 '18 at 16:31

answered Feb 27 '18 at 18:25

Davesexcel

6,896
2
27
42

Long. Very long. See [Gary's answer](https://stackoverflow.com/a/49015423/1188513) for a [much] more efficient solution. – Mathieu Guindon Feb 27 '18 at 18:28
How much faster can it be, the only difference is instead of deleting the rows right away, the range is being added to a range, then deleted. – Davesexcel Feb 27 '18 at 18:55
One single deletion / spreadsheet manipulation, vs up to 375K. Working off a 2D array on top of that would make the entire loop pretty much instant. The difference is very significant, especially with screenupdating, automatic calculation, and worksheet events enabled. – Mathieu Guindon Feb 27 '18 at 18:58
I put a timer on it for 36k rows. My code took 143 seconds, Gary's took 210 seconds – Davesexcel Feb 27 '18 at 19:15
FWIW I my solution consistently completes in ~32 seconds with 36K rows. – Mathieu Guindon Feb 27 '18 at 20:18
@Mat'sMug, would a Fliter_Delete be slower then your solution? – GMalc Feb 27 '18 at 21:04
@GMalc I'd think that would depend on the number of rows involved... there's no silver bullet - worth trying :) – Mathieu Guindon Feb 27 '18 at 21:05
1

@Mat'sMug I added another version, using replace to replace 0 with blanks, then using special cells to delete blank rows. takes 3 seconds for 38k rows, wondering if it works for others – Davesexcel Feb 28 '18 at 16:45
1

FYI I linked to this answer [here](https://stackoverflow.com/a/50398879/1188513) - hopefully this answer gets more votes over time, it's an excellent solution when dealing with very large data sets. – Mathieu Guindon May 17 '18 at 19:15

score 1 · Answer 3 · answered Feb 27 '18 at 20:35

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.

Deleting rows with values based on a column

3 Answers3

Linked

Related