I am trying to delete all rows with blanks values. I have about 15,000 rows and no more than 25% are blank. Here is the code I have.
Columns("A:A").Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.EntireRow.Delete
The first and second lines of code work fine however, when I try to add the third line my spreadsheet times out and I am left with a (Not Responding) message. I think my issue is the amount of rows I am trying to delete at once because the code works when I reduce the amount of content. Can anyone suggest a fix? Why can’t excel handle this?
The reason this takes so long is the large number of discontinuous ranges in
A better way is to sort the data before the delete, so only one continuous range is deleted
You can then restore the original sort order after the delete, something like this:
Sub Demo() Dim rng As Range Dim rSortCol As Range Dim rDataCol As Range Dim i As Long Dim BlockSize As Long Dim sh As Worksheet Dim TempCol As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Set sh = ActiveSheet Set rng = sh.UsedRange With rng ' Add a temporary column to hold a index to restore original sort TempCol = .Column + .Columns.Count Set rSortCol = .Columns(TempCol) rSortCol.Cells(1, 1) = 1 rSortCol.Cells(1, 1).AutoFill rSortCol, xlFillSeries Set rng = rng.Resize(, rng.Columns.Count + 1) Set rDataCol = rng.Columns(1) ' sort on data column, so blanks get grouped together With sh.Sort .SortFields.Clear .SortFields.Add Key:=rDataCol, _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange rng .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' delete blanks (allow for possibility there are no blanks) On Error Resume Next Set rng = rDataCol.SpecialCells(xlCellTypeBlanks) If Err.Number <> 0 Then ' no blank cells Err.Clear Else rng.EntireRow.Delete End If On Error GoTo 0 ' Restore original sort order With sh.Sort .SortFields.Clear .SortFields.Add Key:=rSortCol, _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange rng .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With ' Delete temp column sh.Columns(TempCol).EntireColumn.Delete Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True End Sub
My testing (on ~15000 rows, every 4th row blank) reduced time from ~20s to ~150ms
Your code is running on ALL rows on the spreadsheet; it would be quicker to run it on the used rows.
Something like this:
Range("A1", Cells(Sheet1.Rows.Count, 1).End(xlUp).Address).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Or, could you just sort the data range – that’d group all the blanks together…