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.