How to speed up vba code that delete rows when column Q has blank cells

Question

I have a sheet of almost 100000 rows & column A to Q I have a code that delete entire rows if column Q has blank cells.

I have tried this code on 4000 rows it is running in 3 minutes but when I take 100000 rows it just processing for hours.

I will be very great full if some help/guide me in speeding up this code.

The code is :

Sub DeleteBlank()
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual 
    
    Dim lo As ListObject
    set lo = sheets("BOM 6061").ListObjects(1)
    Sheets("BOM 6061").Activate
    
    lo.AutoFilter.ShowAllData
    lo.range.AutoFilter Field:=17, Criteria1:=""
    
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationAutomatic
    
    lo.DataBodyRange.SpecialCells(xlCellsTypeVisible).Delete
    
    Application.DisplayAlerts = True
    lo.AutoFilter.ShowAllData
End Sub

Sid has an answer about this many years ago I think. If I remember, autofilter is the quickest already. Edit: found [this](https://stackoverflow.com/questions/30959315/excel-vba-performance-1-million-rows-delete-rows-containing-a-value-in-less). — findwindow, Jun 14 '22 at 16:19
Hi, don't turn back on calculation until after you have deleted the cells: `Application.DisplayAlerts = False Application.Calculation = xlCalculationAutomatic` Move this to after the line for SpecialCells.Delete() — topsail, Jun 14 '22 at 16:20
E.g., for example: https://stackoverflow.com/questions/47089741/how-to-speed-up-vba-code (as a reference) — topsail, Jun 14 '22 at 16:21
how it fits in my case , do I need to change my overall code ? @findwindow — Madheea Afroz, Jun 14 '22 at 17:59
I seem to recall that deleting rows from a Table/Listobject is a relatively slow operation ( I timed about 5 secs for deleting half the rows from a 5k row table), so you could consider converting it to a regular range, performing the delete, and then recreating the ListObject. — Tim Williams, Jun 14 '22 at 18:46

score 1 · Accepted Answer · answered Jun 15 '22 at 08:41

Remove Criteria Rows in an Excel Table Efficiently

In a nutshell, if you don't sort the criteria column, deleting the rows may take 'forever'.
The following will do just that, keeping the initial order of the remaining rows.

Option Explicit

Sub DeleteBlankRows()
    
    Const wsName As String = "BOM 6061"
    Const tblIndex As Variant = 1
    Const CriteriaColumnNumber As Long = 17
    Const Criteria As String = ""
    
    ' Reference the table.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim tbl As ListObject: Set tbl = ws.ListObjects(tblIndex)
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Remove any filters.
    If tbl.ShowAutoFilter Then
        If tbl.AutoFilter.FilterMode Then tbl.AutoFilter.ShowAllData
    Else
        tbl.ShowAutoFilter = True
    End If
    
    ' Add a helper column and write an ascending integer sequence to it.
    Dim lc As ListColumn: Set lc = tbl.ListColumns.Add
    lc.DataBodyRange.Value = _
        ws.Evaluate("ROW(1:" & lc.DataBodyRange.Rows.Count & ")")
    
    ' Sort the criteria column ascending.
    With tbl.Sort
        .SortFields.Clear
        .SortFields.Add2 tbl.ListColumns(CriteriaColumnNumber).Range, _
            Order:=xlAscending
        .Header = xlYes
        .Apply
    End With

    ' AutoFilter.
    tbl.Range.AutoFilter Field:=CriteriaColumnNumber, Criteria1:=Criteria
    
    ' Reference the filtered (visible) range.
    Dim svrg As Range
    On Error Resume Next
        Set svrg = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' Remove the filter.
    tbl.AutoFilter.ShowAllData
  
    ' Delete the referenced filtered (visible) range.
    If Not svrg Is Nothing Then svrg.Delete
    
    ' Sort the helper column ascending.
    With tbl.Sort
        .SortFields.Clear
        .SortFields.Add2 lc.Range, Order:=xlAscending
        .Header = xlYes
        .Apply
        .SortFields.Clear
    End With
    
    ' Delete the helper column.
    lc.Delete
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox "Blanks deleted.", vbInformation
    
End Sub

It completes my work with in seconds, Thank You So Much – Madheea Afroz Jun 15 '22 at 09:53 — Madheea Afroz, Jun 15 '22 at 09:53

Blake Daniel · Answer 2 · 2022-06-15T14:09:34.703

I had an simple example of this from a while ago. Advanced filtering is the fastest way to filter in place or to filter and copy in excel/vba. In advanced filtering you usually have your filters listed out in columns/rows and can have as many as you need, use >"" for filtering out blanks on a column, should take no time at all. In my example it might be different as this was used alongside sheetchange to autofilter if anything was added to the filters.

Sub Advanced_Filtering_ModV2()

Dim rc As Long, crc As Long, trc As Long
Dim wb As Workbook, ws As Worksheet
Set wb = ActiveWorkbook: Set ws = wb.Worksheets("sheet1")

ws.Range("AA1").Value = ws.Range("Q1").Value: ws.Range("AA2").Value = ">"""""

On Error Resume Next
ws.ShowAllData: rc = ws.Range("A" & Rows.Count).End(xlUp).Row

ws.Range("A1:V" & rc).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=ws.Range("AA1:AA2")
On Error GoTo 0

End Sub

could you please guide me with a sample code because I have to apply filter on column Q only & then delete rows if any cell in column Q is blank — Madheea Afroz, Jun 14 '22 at 20:10
I updated the procedure to try and work better with your scenario. Again advanced filtering uses a range to filter and so I used column AA, if that is in use edit it to a column not being used. And I assumed your column headers were in row 1 so update that as needed too. — Blake Daniel, Jun 15 '22 at 13:56

Axident · Answer 3 · 2022-06-14T22:01:16.253

I would not use an Autofilter on large data sets as they can take quite a bit of time trying to enumerate the available options before actually filtering the data. The AutoFilter.ShowAllData takes just as much time. For my super simple test dataset, which consisted of 26 columns of 1000000 rows, it took 30+ seconds for each to process.

From what I can tell you are filtering the list to show only the blank items and then deleting the blank rows. Since the filtering is what is causing the delay we could just loop through each row looking at a specific column and if it is blank you can just delete it. Below is an example of how to do this.

**Edit: After testing I found this to be much slower than what you would want. Check out the next example below as it is super fast.

Option Explicit

Sub DeleteBlank()

    Application.ScreenUpdating = False

    Dim calcType As Integer
    Dim rowCount, columnNumToCheck, currow, dataStartRow As Long
    Dim WkSht As String
    Dim lo As ListObject

    WkSht = "BOM 6061" 'The name of the worksheet where the table is located.
    columnNumToCheck = 17 'The column number to check for blank cells.

    calcType = Application.Calculation
    Application.Calculation = xlCalculationManual
    Set lo = Sheets(WkSht).ListObjects(1)
    rowCount = lo.ListRows.Count
    dataStartRow = (lo.DataBodyRange.Row - 1)

    For currow = rowCount To 1 Step -1
        If Sheets(WkSht).Cells((currow + dataStartRow), columnNumToCheck).Value = "" Then
            Call DeleteRows(WkSht, (currow + dataStartRow))
        End If
    Next currow

    Application.Calculation = calcType
    Application.ScreenUpdating = True

End Sub

Private Sub DeleteRows(sheetNameIn As String, startRow As Long, Optional optionalEndRow As Long)

    If IsNull(optionalEndRow) Or optionalEndRow = 0 Then
        optionalEndRow = startRow
    End If

    Worksheets(sheetNameIn).Range(startRow & ":" & optionalEndRow).Delete Shift:=xlUp

End Sub

If you are able to sort your data where the blank cells are all together you could use the below to perform a single delete function remove them all at once. This deleted 70000 rows in a few seconds.

Sub DeleteBlankWithSort()

    'Application.ScreenUpdating = False

    Dim columnNumToCheck, tableLastRow, lrow As Long
    Dim calcType As Integer
    Dim WkSht As String
    Dim lo As ListObject

    WkSht = "BOM 6061" 'The name of the worksheet where the table is located.
    columnNumToCheck = 17 'The column number to check for blank cells.

    calcType = Application.Calculation
    Application.Calculation = xlCalculationManual
    Set lo = Sheets(WkSht).ListObjects(1)
                  
    tableLastRow = FindLastRow(WkSht, (columnNumToCheck))
    
    With lo.Sort
        .SortFields.Clear
        .SortFields.Add _
            Key:=Range("Table1[[#All],[q]]"), _
            SortOn:=xlSortOnValues, _
            Order:=xlDescending, _
            DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    lrow = FindLastRow(WkSht, (columnNumToCheck), (tableLastRow))
    Call DeleteRows(WkSht, (tableLastRow), (lrow + 1))

    Application.Calculation = calcType
    Application.ScreenUpdating = True

End Sub

Private Sub DeleteRows(sheetNameIn As String, startRow As Long, Optional optionalEndRow As Long)

    If IsNull(optionalEndRow) Or optionalEndRow = 0 Then
        optionalEndRow = startRow
    End If

    Worksheets(sheetNameIn).Range(startRow & ":" & optionalEndRow).Delete Shift:=xlUp

End Sub

Private Function FindLastRow(sheetNameIn As String, columnNum As Long, Optional optionalStartRow As Long) As Long
'finds the last row of the column passed in the sheetname passed in
    
    If IsNull(optionalStartRow) Or optionalStartRow = 0 Then
        optionalStartRow = 1048576
    End If
    
    FindLastRow = Worksheets(sheetNameIn).Range(Cells(optionalStartRow, columnNum).Address).End(xlUp).Row
    
End Function

How to speed up vba code that delete rows when column Q has blank cells

3 Answers3

Remove Criteria Rows in an Excel Table Efficiently