Fastest way to Delete whole row based on Blank Cell - excel

Question

There are so many ways to delete a whole row based on a blank cell in specific column. What I want to know is which is the fastest way to accomplish this task in terms of Excel speed. I have a sheet with about 39,000 original rows of data which then becomes 21,000 rows after I run the code below. The issue is the chunk of code takes almost 60 seconds to return. While I know CPU and such is a factor, but lets assume all else being equal.
I am using Column A as the total count of rows and Column F as the location of blank cells. Is this the best/ fastest way to write this code?
' Finds the last row with a file numbers and removes the remaining rows
Dim LastRow As Integer
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("F2:F" & LastRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Answer 1

Try this (wishing it would help, although take backup of your sheet before!):
Sub FastestBlankRowTerminator()
ActiveSheet.UsedRange.Columns(6).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Answer 2

One of the simplest things I can advise that should increase performance by a noticeable amount is to turn off screen updating and automatic calculation while running this procedure.
I typically turn these items off at the initial invocation of code and turn them back on after the final one. Meaning I would have one sub to contain a series of other subs and functions that it would execute in sequence. Instead of embedding this in those subs and functions individually I just set them off, execute the main sub, and then reset them.
' Speed Up
application.screenupdating = false
application.calculation = xlCalculationManual
<insert code you want to improve performance on here>
' Slow Down
application.screenupdating = true
application.calculation = xlCalculationAutomatic
I ran a test myself populating column a with a rowcount up to 39000 and then every other record would have a "1" in column f.
It still takes some time but only 46 seconds on my core2duo, if I don't turn off screen updating it takes 3 minutes and 34 seconds.
Sub Main()
' Speed Up
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Begin ' Main Sub
' Reset
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Begin()
' Sub 1
' Sub 2
' Sub 3
Remove_Blanks
End Sub
Sub Remove_Blanks()
Dim dA As Date, dB As Date
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Long, j As Integer
Dim r As Long, c As Integer
dA = Now
' Commented out to indicate they could be here but if you are executing multiple procedures then you should have it occur outside of this.
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
With ws
For r = 1 To .UsedRange.Rows.Count
If .Cells(r, 6) = "" Then .Rows(r).Delete
Next r
End With
dB = Now
'Commented out for same reason above
'Application.ScreenUpdating = True
'Application.Calculation = xlCalculationAutomatic
Debug.Print "Remove_Blanks: " & Format((dB - dA), "mm/dd/yyyy hh:mm:ss")
End Sub

Answer 3

I set up a matrix of 50,000 rows x 12 columns. In column F I placed about 25,000 blanks randomly placed.
Read the used range into an array
Iterate through the array and read those rows with content in column F into a results array
Clear the original data
write the results array
A lot of steps, but the execution time was less than one second; it would probably be faster with screenupdating false; and longer if you have more columns.
EDIT: Screenupdating false did not significantly decrease the execution speed, which was approximately 0.36 seconds when timed with a hi-res timer.
EDIT2: After reading Tim Williams comment about preserving formatting and formulas, I present a different approach. This approach will use the Advanced Filter and, on the same made up data as above, will place the data on another worksheet minus the rows that have blanks in column F. This does require a first row of column headers in the data; or, at least, that F1 has a unique, non-blank value.
To accomplish that process takes about 0.15 seconds.
If you also want to copy it back over the original worksheet, and delete the added worksheet, that will take about another 0.3 seconds.
Here is some code to do that, but you'd have to alter it for your own specifications:
==============================================
Sub DeleteBlankFRows2()
Dim WS As Worksheet, wsTemp As Worksheet, rTemp As Range
Dim R As Range, rCrit As Range
Dim I As Long
Set WS = Worksheets("Sheet5")
Set R = WS.Range("a1").CurrentRegion
Set rCrit = R.Offset(0, R.Columns.Count + 3).Resize(2, 1)
rCrit(1) = R(1, 6)
rCrit(2) = "<>"
Application.ScreenUpdating = False
Worksheets.Add
Set wsTemp = ActiveSheet
wsTemp.Name = "Temp"
R.AdvancedFilter xlFilterCopy, rCrit, Cells(1, 1)
Set rTemp = wsTemp.Cells(1, 1).CurrentRegion
WS.Cells.Clear
rTemp.Copy WS.Cells(1, 1)
Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
=======================================
This was my original code using VBA arrays:
===========================
Sub foo()
Dim vSrc As Variant, vRes() As Variant
Dim rSrc As Range
Dim I As Long, J As Long, K As Long
Dim lRows As Long
'Or may need to use a different method to include everything
Set rSrc = Range("a1").CurrentRegion
vSrc = rSrc
'how many rows to retain
For I = 1 To UBound(vSrc)
If vSrc(I, 6) <> "" Then lRows = lRows + 1
Next I
ReDim vRes(1 To lRows, 1 To UBound(vSrc, 2))
K = 0
For I = 1 To UBound(vSrc)
If vSrc(I, 6) <> "" Then
K = K + 1
For J = 1 To UBound(vSrc, 2)
vRes(K, J) = vSrc(I, J)
Next J
End If
Next I
Cells.Clear
Range("a1").Resize(UBound(vRes, 1), UBound(vRes, 2)) = vRes
End Sub