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:Care empty, remember it if they are and then delete them all at the end - Loop through each column in
A:Cand 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,
rngToDeleteholds a reference toA2:A3,A5:A6,A8. Perfect. - After the 2nd iteration of the loop,
rngToDeleteholds a reference toB3,B5,B8. Perfect. - After the 3rd iteration of the loop,
rngToDeleteholds a reference toC5,C8so the code then deletes rows5and8. 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,
rngToDeleteholds a reference toA3. Perfect. - After the 2nd iteration of the loop,
rngToDeleteholds a reference toA3. Ouch. - After the 3rd iteration of the loop,
rngToDeleteholds a reference toA3so 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