Excel VBA – Delete Rows on Condition

We’re getting a lot of questions on our Excel board about how to delete rows in Excel given various conditions. I’ve assembled a few examples which should help you get started if you face such a task. This thread is a collection of code samples – not a tutorial.

There is functionality available to us within the Excel Object Model which, when used correctly, allows us to reliably and efficiently delete unwanted rows of data from our workbooks. Here are some popular variations:

Working With The Range Object’s SpecialCells Method

Working With The Range Object’s Find and AutoFilter Methods

Note – Determining The Last Used Row

Throughout the thread I call the following function to determine the last populated row of a specified range:

Code:

Public Function GetLastRow(ByVal rngToCheck As Range) As Long

    Dim rngLast As Range

    Set rngLast = rngToCheck.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious)

    If rngLast Is Nothing Then
        GetLastRow = rngToCheck.Row
    Else
        GetLastRow = rngLast.Row
    End If

End Function

Delete Rows If Cells In A Certain Column Are Empty

Here’s a skeleton procedure to demonstrate quick and simple way to delete each row in Sheet1 if the cells in Column A are empty:

Code:

Sub Example1()

    Dim lngLastRow As Long
    Dim rngToCheck As Range

    Application.ScreenUpdating = False

    With Sheet1
        'if the sheet is empty then exit...
        If Application.WorksheetFunction.CountA(.Cells) > 0 Then

            'find the last row in the worksheet
            lngLastRow = GetLastRow(.Cells)

            Set rngToCheck = .Range(.Cells(1, 1), .Cells(lngLastRow, 1))

            If rngToCheck.Count > 1 Then
                'if there are no blank cells then there will be an error
                On Error Resume Next
                rngToCheck.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                On Error GoTo 0
            Else
                If VBA.IsEmpty(rngToCheck) Then rngToCheck.EntireRow.Delete
            End If
        End If
    End With

    Application.ScreenUpdating = True

End Sub

SpecialCells From A Single Cell

Note that if rngToCheck is a single cell then the SpecialCells method unexpectedly returns a union related to the blank cells (in this case we used the xlCellTypeBlanks constant) and used range of the sheet so I have defensively coded for this by checking rngToCheck’s Count property (since we are working with a single column the Count property will also be sufficient in Excel 2007 or later – if there is a chance that the cells count could exceed 2,147,483,647 then you should useCountLarge).

Limit Of 8,192 Non-Contiguous Cells

Initially it appears that a great thing about using the range object’s SpecialCells method is that we can avoid having to use any looping structures.

However, one nuance we have to be careful of is that this method will return a reference to the entire qualifier range if there are more than 2^13 (in this case blank) non-contiguous cells. There is a MS Help and Support article describing the issue:
http://support.microsoft.com/?kbid=832293
This issue has been resolved in Excel 2010.

So, a more robust solution is to check the cell count of the first area of the specialcells range and, if necessary, introduce a loop which steps through 2^14 cells at a time. Ron De Bruin’s done the hard work for us:
http://www.rondebruin.nl/specialcells.htm

Note: The later examples in this thread will ignore this, but obviously bear it in mind!

Delete Rows If Any Cells In The Row Are Empty

This example expands on the previous one but introduces yet another nuance when working with the range object’sSpecialCells method. This example will delete all rows in the worksheet if the ANY of their cells within columns B to E are empty. Of course, the column intersect you are checking can be changed easily.

Code:

Sub Example1()

    Dim lngLastRow As Long
    Dim rngToCheck As Range, rngToDelete As Range

    Application.ScreenUpdating = False

    With Sheet1

        'find the last row on the sheet
        lngLastRow = GetLastRow(.Cells)

        If lngLastRow > 1 Then
            'we want to check the used range in columns B to E
            'except for our header row which is row 1
            Set rngToCheck = .Range(.Cells(2, "b"), .Cells(lngLastRow, "e"))

            'if there are no blank cells then there will be an error
            On Error Resume Next
            Set rngToDelete = rngToCheck.SpecialCells(xlCellTypeBlanks)
            On Error GoTo 0

            'allow for overlapping ranges
            If Not rngToDelete Is Nothing Then _
                    Application.Intersect(.Range("A:A"), rngToDelete.EntireRow).EntireRow.Delete
        End If
    End With

    Application.ScreenUpdating = True
End Sub

The key piece of defensive coding is the part which allows for overlapping ranges. If a single row contains two non-contiguous blank cells with columns B to E then, if we try to delete the entire row directly from the union range returned by the specialcells method, we will get an error:

Code:

        'this line of code could cause an error when working with more than 2 columns
        If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

To allow for this we resolve each empty cell found to the first column of that row and then delete:

Code:
        'allow for overlapping ranges
        If Not rngToDelete Is Nothing Then _
                Application.Intersect(.Range("A:A"), rngToDelete.EntireRow).EntireRow.Delete

Delete Rows If A Column Contains A Certain Value

The most traditional approach to tackle this task is to loop through the entire column, check to see if each cell contains the value and, if it does, delete the row. Since Excel shifts rows upwards when they are deleted, it is best to start at the bottom of the column and work upwards thereby negating the row shift effect.

This approach can be quite slow (even with the Application Object’s ScreenUpdating and Calculation properties set to False/Manual) for two reasons:

  1. Deleting a row triggers an Excel recalculation which can be particularly time consuming if there are a lot of formulas or links. So, rather than deleting each row as we identify it, the approach we will use is to take a note of it and then, once we know all the rows that need to be deleted, we delete them altogether in one go. Another approach would be to store the cell contents we want in an array, clear all the cells and then populate them from that array. This would be a good workaround which avoids deleting the rows at all but, issues such as cell formats and formula dependencies, often mean that this option isn’t viable.
  2. Looping through all the cells in a column (or even just the used cells within a column) is time consuming. We can reduce the number of iterations within the loop by using the range object’s Find method or, if the worksheet is set up in a suitable format, we can use the range object’s Autofilter method.

Using The Range Object’s Find Method

Code:

Sub Example1()

    Const strTOFIND As String = "Hello"

    Dim rngFound As Range, rngToDelete As Range
    Dim strFirstAddress As String

    Application.ScreenUpdating = False

    With Sheet1.Range("A:A")
        Set rngFound = .Find( _
                            What:=strTOFIND, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=True)

        If Not rngFound Is Nothing Then
            Set rngToDelete = rngFound

            'note the address of the first found cell so we know where we started.
            strFirstAddress = rngFound.Address

            Set rngFound = .FindNext(After:=rngFound)

            Do Until rngFound.Address = strFirstAddress
                Set rngToDelete = Application.Union(rngToDelete, rngFound)
                Set rngFound = .FindNext(After:=rngFound)
            Loop
        End If
    End With

    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

    Application.ScreenUpdating = True

End Sub

Using The Range Object’s Autofilter Method

This procedure assumes that Row 1 contains field headers.

Code:

Sub Example2()

    Const strTOFIND As String = "Hello"

    Dim lngLastRow As Long
    Dim rngToCheck As Range

    Application.ScreenUpdating = False

    With Sheet1
        'find the last row in the Sheet
        lngLastRow = GetLastRow(.Cells)

        Set rngToCheck = .Range(.Cells(1, 1), .Cells(lngLastRow, 1))
    End With

    With rngToCheck
        .AutoFilter Field:=1, Criteria1:=strTOFIND

        'assume the first row had headers
        On Error Resume Next
        .Offset(1, 0).Resize(.Rows.Count - 1, 1). _
            SpecialCells(xlCellTypeVisible).EntireRow.Delete
        On Error GoTo 0

        'remove the autofilter
        .AutoFilter
    End With

    Application.ScreenUpdating = True

End Sub

Delete Rows If A Column Does Not Contain A Certain Value

This is very similar to the previous post except for an inversion of the logic. Whilst inverting the logic of theRange.Autofilter() approach is very straightforward, a slightly different approach with the Range.Find() method is required.

Using The Range Object’s Find / ColumnDifferences Methods

This procedure is adapted from a post by MS MVPs Richard Schollar and Rory Archibald. We search column A for the string “Hello” – which is the value we wish to keep – and then we use the Range.ColumnDifferences() method to return all the cells in the column which have a different value. Note that the Range.ColumnDifferences() method is also subject to the 8,192 non-contiguous cells limitation mentioned at the beginning of this thread.

Code:

Sub Example1()

    Const strTOFIND As String = "Hello"

    Dim lngLastRow As Long
    Dim rngToCheck As Range, rngFound As Range, rngToDelete As Range

    Application.ScreenUpdating = False

    With Sheet1
        lngLastRow = GetLastRow(.Cells)

        If lngLastRow > 1 Then
            'we don't want to delete our header row
            With .Range("A2:A" & lngLastRow)

                Set rngFound = .Find( _
                                    What:=strTOFIND, _
                                    Lookat:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=True _
                                        )

                If rngFound Is Nothing Then
                    'there are no cells we want to keep!
                    .EntireRow.Delete

                Else

                    'determine all the cells in the range which have a different value
                    On Error Resume Next
                    Set rngToDelete = .ColumnDifferences(Comparison:=rngFound)
                    On Error GoTo 0

                    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

                End If
            End With
        End If
    End With

    Application.ScreenUpdating = True

End Sub

Using The Range Object’s Autofilter Method

The method is exactly the same for the autofilter approach in the previous post except that we change the comparison operator from “=” to “<>”. Again, a proper worksheet table structure is assumed with the field headers in row 1.

Code:

Sub Example2()

    Const strTOFIND As String = "Hello"

    Dim lngLastRow As Long
    Dim rngToCheck As Range

    Application.ScreenUpdating = False

    With Sheet1
        'find the last row in the sheet
        lngLastRow = GetLastRow(.Cells)

        Set rngToCheck = .Range(.Cells(1, 1), .Cells(lngLastRow, 1))
    End With

    With rngToCheck
        .AutoFilter field:=1, Criteria1:="<>" & strTOFIND

        'assume the first row had headers
        On Error Resume Next
        .Offset(1, 0).Resize(.Rows.Count - 1, 1). _
            SpecialCells(xlCellTypeVisible).EntireRow.Delete
        On Error GoTo 0

        'remove the autofilter
        .AutoFilter
    End With

    Application.ScreenUpdating = True

End Sub

Delete Rows If A Column Contains One Of Several Values

An equally common task is to delete a row if any one of a list of words is contained within a certain column.

The discussion on the previous post applies equally and we just have to add an additional loop to iterate through thekeywords. In the examples below I have used an array but you could just as easily use a range.

Using The Range Object’s Find Method

Code:

Sub Example1()

    Dim rngFound As Range, rngToDelete As Range
    Dim strFirstAddress As String
    Dim varList As Variant
    Dim lngCounter As Long

    Application.ScreenUpdating = False

    varList = VBA.Array("Here", "There", "Everywhere")

    For lngCounter = LBound(varList) To UBound(varList)

        With Sheet1.Range("A:A")
            Set rngFound = .Find( _
                                What:=varList(lngCounter), _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True _
                                    )

            If Not rngFound Is Nothing Then
                If rngToDelete Is Nothing Then
                    Set rngToDelete = rngFound
                Else
                    Set rngToDelete = Application.Union(rngToDelete, rngFound)
                End If

                strFirstAddress = rngFound.Address
                Set rngFound = .FindNext(After:=rngFound)

                Do Until rngFound.Address = strFirstAddress
                    Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    Set rngFound = .FindNext(After:=rngFound)
                Loop
            End If
        End With
    Next lngCounter

    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

    Application.ScreenUpdating = True

End Sub