Deleting rows. We all need to do it from time to time and I often find myself referring to how to delete rows using VBA. It has a bunch of handy code snippets and notes on using Range.Find()
, Range.Autofilter()
and Range.SpecialCells()
which can be quickly adapted to do all sorts of things. However, one important scenario missing from that post is how to delete rows when all cells in a given range are empty: something which I’m going to put right now.
Here’s my data in A1:D9
:
I want to delete rows 5
and 8
because all the cells in columns A
to C
are empty on those rows. Some ways of tackling this conundrum are:
- Loop through each row, use
WorksheetFunction.CountA()
to determine if the cells inA:C
are empty, remember it if they are and then delete them all at the end - Loop through each column in
A:C
and useRange.SpecialCells()
to identify the empties, and then any entirely empty rows at the end - If the data has a structured layout (in this case column headers are missing), use an autofilter and apply a ‘not empty’ filter to every column and then delete the visible cells
- Variations of the above but avoid deleting rows by applying intelligent sorts and clearing the cell contents
Approach (2) looks pretty good to me in terms of a useful code snippet, so I’m going to try to implement it below but, to make things more interesting, I’m going to make some common mistakes which need to be fixed.
Here’s my first effort:
Sub test() Dim rngToCheck As Range Dim rngToDelete As Range Dim rngCol As Range Set rngToCheck = Range("A1:C9") Set rngToDelete = rngToCheck.Columns(1) For Each rngCol In rngToCheck.Columns On Error Resume Next Set rngToDelete = Intersect( _ rngToDelete.EntireRow, _ rngCol.SpecialCells(xlCellTypeBlanks)) On Error GoTo 0 If rngToDelete Is Nothing Then Exit Sub Next rngCol Application.ScreenUpdating = False rngToDelete.EntireRow.Delete Application.ScreenUpdating = True End Sub
It works well on the sample data. It gives rngToDelete
a reference to A1:A9
and then loops through columns A
to C
checking for empty cells.
- After the 1st iteration of the loop,
rngToDelete
holds a reference toA2:A3,A5:A6,A8
. Perfect. - After the 2nd iteration of the loop,
rngToDelete
holds a reference toB3,B5,B8
. Perfect. - After the 3rd iteration of the loop,
rngToDelete
holds a reference toC5,C8
so the code then deletes rows5
and8
. Perfect.
But wait, there are some bugs: you have to be so careful when using Range.SpecialCells()
.
Let’s test the code on some different data:
The code shouldn’t delete any of these rows but, if you run it, you’ll find that it deletes row 3
! Not good. Not good at all.
The reason for this is Range.SpecialCells(xlCellTypeBlanks)
throws an error when there are no empty cells. The code assumes it returns Nothing
which means that rngToDelete
simply retains its reference from the previous iteration in the loop:
- After the 1st iteration of the loop,
rngToDelete
holds a reference toA3
. Perfect. - After the 2nd iteration of the loop,
rngToDelete
holds a reference toA3
. Ouch. - After the 3rd iteration of the loop,
rngToDelete
holds a reference toA3
so the code then deletes rows3
. Ouch.
There are a couple of ways this can be fixed, one of which is to move the Range.SpecialCells()
call into a separate function which will return Nothing
if an error occurs:
Sub test2() Dim rngToCheck As Range Dim rngToDelete As Range Dim rngCol As Range Set rngToCheck = Range("A1:C9") Set rngToDelete = rngToCheck.Columns(1) For Each rngCol In rngToCheck.Columns Set rngToDelete = Intersect( _ rngToDelete.EntireRow, _ GetEmptyCells(rngCol)) If rngToDelete Is Nothing Then Exit Sub Next rngCol Application.ScreenUpdating = False rngToDelete.EntireRow.Delete Application.ScreenUpdating = True End Sub Private Function GetEmptyCells(ByRef rngToCheck As Range) As Range On Error Resume Next Set GetEmptyCells = rngToCheck.SpecialCells(xlCellTypeBlanks) End Function
Now that the On Error Resume Next
has been tucked out-of-the-way, a second issue reveals itself. Application.Intersect()
will throw a “No cells were found” error if GetEmptyCells()
returns Nothing
. This can be fixed by adding some defensive coding:
Sub test3() Dim rngToCheck As Range Dim rngToDelete As Range Dim rngCol As Range Set rngToCheck = Range("A1:C9") Set rngToDelete = rngToCheck.Columns(1) For Each rngCol In rngToCheck.Columns Set rngToDelete = GetIntersect( _ rngToDelete.EntireRow, _ GetEmptyCells(rngCol)) If rngToDelete Is Nothing Then Exit Sub Next rngCol Application.ScreenUpdating = False rngToDelete.EntireRow.Delete Application.ScreenUpdating = True End Sub Private Function GetEmptyCells(ByRef rngToCheck As Range) As Range On Error Resume Next Set GetEmptyCells = rngToCheck.SpecialCells(xlCellTypeBlanks) End Function Private Function GetIntersect(ByRef rng1 As Range, _ ByRef rng2 As Range) As Range If Not (rng1 Is Nothing Or rng2 Is Nothing) Then Set GetIntersect = Intersect(rng1, rng2) End If End Function
That all seems to be working now.
But wait! Let’s change the data again and suppose we’re running this just on a single row, row 1
:
If you change the rngToCheck
variable to reference A1:C1
you’ll find that the code deletes the row even though cells A1
and B1
aren’t empty! The reason for this is, as it loops through each column, the rngCol
variable holds a reference to a single cell. I’ve got some important notes on Range.SpecialCells()
from a single cell on my other blog post which explain the problem so I won’t repeat them here but, essentially, the GetEmptyCells()
method needs to check if rngToCheck
is a single cell, like so:
Sub test4() Dim rngToCheck As Range Dim rngToDelete As Range Dim rngCol As Range Set rngToCheck = Range("A1:C1") Set rngToDelete = rngToCheck.Columns(1) For Each rngCol In rngToCheck.Columns Set rngToDelete = GetIntersect( _ rngToDelete.EntireRow, _ GetEmptyCells(rngCol)) If rngToDelete Is Nothing Then Exit Sub Next rngCol Application.ScreenUpdating = False rngToDelete.EntireRow.Delete Application.ScreenUpdating = True End Sub Private Function GetEmptyCells(ByRef rngToCheck As Range) As Range If rngToCheck.Cells.CountLarge = 1 Then If IsEmpty(rngToCheck.Value2) Then Set GetEmptyCells = rngToCheck End If Else On Error Resume Next Set GetEmptyCells = rngToCheck.SpecialCells(xlCellTypeBlanks) End If End Function Private Function GetIntersect(ByRef rng1 As Range, _ ByRef rng2 As Range) As Range If Not (rng1 Is Nothing Or rng2 Is Nothing) Then Set GetIntersect = Intersect(rng1, rng2) End If End Function
I’ve used Range.CountLarge
which means that I’m assuming the code is for XL 2007 or later. This also means that I don’t have to worry about the Range.SpecialCells()
limit of 8,192 non-contiguous cells.
Nearly there now, but there’s one more scenario we need to cater for. If you add a new sheet to the workbook, carefully enter the data below and then run the code using A1:C9
as the rngToCheck
, you’ll find that row 2
doesn’t get deleted.
The reason for this one is that Range.SpecialCells()
intrinsically only checks cells within the sheet’s used range. In this case, the used range is A1:B3
so Range.SpecialCells()
doesn’t even consider cells in column C
to exist. This means that in the final iteration of the loop the GetEmptyCells()
call returns Nothing
. Again, there are a couple of ways we can deal with this but an easy option is to use our existing GetIntersect()
function to trim down rngToCheck
to fit within the used range. Calling the Worksheet.UsedRange
property can be expensive so the fix can be added into the main Sub
rather than in the GetIntersect()
method which gets called repeatedly.
Here’s the final, tidied up version. I’ve coded it to throw an error if the rngToCheck
doesn’t intersect with the used range but you could just silently exit if you prefer.
Sub Example() 'deletes the rows in sheet1 1:9 'if all the corresponding cells in columns A:C are empty DeleteRowsIfAllCellsEmpty Sheet1.Range("A1:C9") End Sub Public Sub DeleteRowsIfAllCellsEmpty(ByVal rngToCheck As Range) Dim rngToDelete As Range Dim rngCol As Range Set rngToCheck = GetIntersect( _ rngToCheck, _ rngToCheck.Worksheet.UsedRange) If rngToCheck Is Nothing Then Err.Raise _ Number:=1004, _ Description:="rngToCheck does not intersect with the UsedRange" Exit Sub End If Set rngToDelete = rngToCheck.Columns(1) For Each rngCol In rngToCheck.Columns Set rngToDelete = GetIntersect( _ rngToDelete.EntireRow, _ GetEmptyCells(rngCol)) If rngToDelete Is Nothing Then Exit Sub Next rngCol Application.ScreenUpdating = False rngToDelete.EntireRow.Delete Application.ScreenUpdating = True End Sub Private Function GetEmptyCells(ByRef rngToCheck As Range) As Range If rngToCheck.Cells.CountLarge = 1 Then If IsEmpty(rngToCheck.Value2) Then Set GetEmptyCells = rngToCheck End If Else On Error Resume Next Set GetEmptyCells = rngToCheck.SpecialCells(xlCellTypeBlanks) End If End Function Private Function GetIntersect(ByRef rng1 As Range, _ ByRef rng2 As Range) As Range If Not (rng1 Is Nothing Or rng2 Is Nothing) Then Set GetIntersect = Intersect(rng1, rng2) End If End Function
Very interesting, thanks for the detailed walk-through.
LikeLike