Delete Rows If All Cells In A Given Range Are Empty

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:

SampleData1

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:

  1. Loop through each row, use WorksheetFunction.CountA() to determine if the cells in A:C are empty, remember it if they are and then delete them all at the end
  2. Loop through each column in A:C and use Range.SpecialCells() to identify the empties, and then any entirely empty rows at the end
  3. 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
  4. 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 to A2:A3,A5:A6,A8. Perfect.
  • After the 2nd iteration of the loop, rngToDelete holds a reference to B3,B5,B8. Perfect.
  • After the 3rd iteration of the loop, rngToDelete holds a reference to C5,C8 so the code then deletes rows 5 and 8. 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:

SampleData2

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 to A3. Perfect.
  • After the 2nd iteration of the loop, rngToDelete holds a reference to A3. Ouch.
  • After the 3rd iteration of the loop, rngToDelete holds a reference to A3 so the code then deletes rows 3. 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:

SampleData3

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.

SampleData4

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

Advertisements

About Colin Legg

RAD Developer Microsoft MVP - Excel 2009 - 2014
This entry was posted in Microsoft Excel and tagged , , , . Bookmark the permalink.

One Response to Delete Rows If All Cells In A Given Range Are Empty

  1. cyrilbrd says:

    Very interesting, thanks for the detailed walk-through.

    Like

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s