Deleting ranges of rows from a spreadsheet

Question

I'm currently trying to create a macro, to edit a document that is around 280k rows and 12 columns. For the first steps I found a macro to delete the rows I don't want based on certain criteria, but the code repeats itself a lot. Every time I run it, I change the criteria and link the macros.

Also, is there a better way to reuse this code, rather than to modify it each time?

Sub jbeck1()
Dim i As Long
Dim LR As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LR = Cells(Rows.Count, 1).End(xlUp).Row

For i = LR To 2 Step -1

If Range("E" & i) = "0020" Then
    Range("E" & i).EntireRow.Delete Shift:=xlUp
End If

Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.Run "jbeck2"

End Sub
Sub jbeck2()
Dim i As Long
Dim LR As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LR = Cells(Rows.Count, 1).End(xlUp).Row

For i = LR To 2 Step -1

If Range("E" & i) = "0021" Then
    Range("E" & i).EntireRow.Delete Shift:=xlUp
End If

Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.Run "jbeck3"
End Sub

Answer 1

Instead of looping through every single line and then deleting it if it matches your criteria, you could build a string that contains the exact ranges you want to delete. Then once the loop is complete you could call a single Range().Delete call. You also can make the macro take in a string that you wish to delete.

Sub MacroDelete(S As String)

Dim i As Long
Dim LR As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LR = Cells(Rows.Count, 1).End(xlUp).Row

Dim RangeToDelete As String
Dim Count As Integer
Dim numRowsToDelete As Integer

RangeToDelete = ""
Count = 0

' cheap way to get the total amount we want to delete
numRowsToDelete = Application.WorksheetFunction.CountIf(Range("E:E"), S) - Application.WorksheetFunction.CountIf(Range("E1:E2"), S)

For i = LR To 2 Step -1

' build the range string
If Range("E" & i) = S Then
    Count = Count + 1
    RangeToDelete = RangeToDelete & i & ":" & i
    If Count < numRowsToDelete Then
        RangeToDelete = RangeToDelete & ","
    End If
End If

Next i

' delete all the rows found matching S
Range(RangeToDelete).Delete Shift:=xlUp

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

You can see @D_Zab's answer for an understanding on how to call subs or functions from other subs

Answer 2

Write a separate subroutine and reference it:

Sub DeleteRows(Item As Integer)
Dim i As Integer
Dim LR As Integer

LR = Cells(Rows.Count, 1).End(xlUp).Row

For i = LR To 2 Step -1
    If Range("E" & i) = Item Then
        Range("E" & i).EntireRow.Delete Shift:=xlUp
    End If
Next i
End Function

Reference it by inserting a reference in another Sub:

DeleteRows 0020

'Do some more stuff

DeleteRows 0021

See more info here

Answer 3

Especially as your data set increases in size, looping through each row and deleting corresponding rows will take a long time and may even tax your system. A possible workaround exists where, using a macro, you add an autofilter that selects the cells your want to delete, then ClearContents (rather than Delete), then sort the entire dataset in descending order. This will move all of the cleared rows to the bottom of the dataset, and out of the picture.

The benefits to this:

1. (At least on my system) It is MUCH faster.
2. The Autofilter allows you to select multiple criteria at once, where necessary.

The disadvantages:

1. It doesn't work with all data structures (Summary rows at the end of the dataset, for example).
2. One of the columns will be used to sort in descending order, which will change the order of your data (usually not a big deal, but each case is unique).

Here's some example code:

Sub DelFilterSort()
    Dim ws As Worksheet
    Dim LR As Long

    Application.ScreenUpdating = False

    Set ws = ActiveSheet
    LR = Cells(Rows.Count, 1).End(xlUp).Row

    ws.Range("A1").CurrentRegion.AutoFilter Field:=5, Criteria1:="0021"
    ws.Range("A2:E" & LR).ClearContents
    ws.AutoFilterMode = False

    ws.Range("A1:E" & LR).Sort key1:=Range("A1"), order1:=xlDescending, Header:=xlYes

    Application.ScreenUpdating = True

End Sub

Answer 4

Formatting the code can help when you are trying to look at the bigger picture, so I suggest that you start with making sure that your code is much, much more readable, this will help you discover other things that you can change to make this code more efficient, let's just start with the formatting.

Here is your code

Sub jbeck1()
Dim i As Long
Dim LR As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LR = Cells(Rows.Count, 1).End(xlUp).Row

For i = LR To 2 Step -1

If Range("E" & i) = "0020" Then
    Range("E" & i).EntireRow.Delete Shift:=xlUp
End If

Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.Run "jbeck2"

End Sub
Sub jbeck2()
Dim i As Long
Dim LR As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LR = Cells(Rows.Count, 1).End(xlUp).Row

For i = LR To 2 Step -1

If Range("E" & i) = "0021" Then
    Range("E" & i).EntireRow.Delete Shift:=xlUp
End If

Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.Run "jbeck3"

Here is what it looks like after you:

• Indent the code inside sub's
• Indent the code inside For loops
• Include the End Sub for the second Sub

Sub jbeck1()
    Dim i As Long
    Dim LR As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    LR = Cells(Rows.Count, 1).End(xlUp).Row

    For i = LR To 2 Step -1
        If Range("E" & i) = "0020" Then
            Range("E" & i).EntireRow.Delete Shift:=xlUp
        End If
    Next i

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.Run "jbeck2"   
End Sub

Sub jbeck2()
    Dim i As Long
    Dim LR As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    LR = Cells(Rows.Count, 1).End(xlUp).Row

    For i = LR To 2 Step -1
        If Range("E" & i) = "0021" Then
            Range("E" & i).EntireRow.Delete Shift:=xlUp
        End If
    Next i

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.Run "jbeck3"
End Sub

I also removed unnecessary newlines from the for loops, since now you can see them because they are properly indented.

---

All of this makes it easier to read. When I first looked at your code I thought it was one Sub and then when I went to put the indentation in I realized that this is actually 2 Sub's, that makes a big difference in how you look at the code.