Go Back  Xtreme Visual Basic Talk > Legacy Visual Basic (VB 4/5/6) > Knowledge Base > Code Library > Excel VBA: How To Delete Rows


Reply
 
Thread Tools Display Modes
  #1  
Old 09-24-2008, 06:02 AM
Colin Legg's Avatar
Colin Legg Colin Legg is offline
Out Of Office

Retired Moderator
* Expert *
 
Join Date: Mar 2005
Location: London, UK
Posts: 3,398
Default Excel VBA: How To Delete Rows


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 - so, if you have any questions about deleting rows once you have read the article, please start a new thread on the Excel board so that we can try to help. An updated version of this article will soon be available here.

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

Last edited by Colin Legg; 09-13-2011 at 03:01 AM.
Reply With Quote
  #2  
Old 09-24-2008, 06:05 AM
Colin Legg's Avatar
Colin Legg Colin Legg is offline
Out Of Office

Retired Moderator
* Expert *
 
Join Date: Mar 2005
Location: London, UK
Posts: 3,398
Default 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 use CountLarge).


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!

Last edited by Colin Legg; 12-19-2010 at 05:48 AM.
Reply With Quote
  #3  
Old 09-24-2008, 06:05 AM
Colin Legg's Avatar
Colin Legg Colin Legg is offline
Out Of Office

Retired Moderator
* Expert *
 
Join Date: Mar 2005
Location: London, UK
Posts: 3,398
Default 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's SpecialCells 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

Last edited by Colin Legg; 12-16-2010 at 05:14 PM.
Reply With Quote
  #4  
Old 09-24-2008, 06:15 AM
Colin Legg's Avatar
Colin Legg Colin Legg is offline
Out Of Office

Retired Moderator
* Expert *
 
Join Date: Mar 2005
Location: London, UK
Posts: 3,398
Default 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

Last edited by Colin Legg; 06-06-2011 at 10:54 AM.
Reply With Quote
  #5  
Old 09-24-2008, 06:15 AM
Colin Legg's Avatar
Colin Legg Colin Legg is offline
Out Of Office

Retired Moderator
* Expert *
 
Join Date: Mar 2005
Location: London, UK
Posts: 3,398
Default 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 the Range.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

Last edited by Colin Legg; 12-16-2010 at 04:50 PM.
Reply With Quote
  #6  
Old 09-24-2008, 07:14 AM
Colin Legg's Avatar
Colin Legg Colin Legg is offline
Out Of Office

Retired Moderator
* Expert *
 
Join Date: Mar 2005
Location: London, UK
Posts: 3,398
Default 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 the keywords. 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
Using The Range Object's Autofilter Method

Note that this code is only applicable to Excel 2007 or later.
Code:
Sub Example2()
   
    Dim lngLastRow As Long
    Dim rngToCheck As Range
    Dim varList As Variant
    
    Application.ScreenUpdating = False
    
    vList = VBA.Array("Here", "There", "Everywhere")
    
    With Sheet1
        'find the last row in column A
        lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        Set rngToCheck = .Range(.Cells(1, 1), .Cells(lngLastRow, 1))
    End With
    
    With rngToCheck
        .AutoFilter _
            Field:=1, _
            Criteria1:=vList, _
            Operator:=xlFilterValues
        
        '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

Last edited by Colin Legg; 12-16-2010 at 05:02 PM.
Reply With Quote
  #7  
Old 09-24-2008, 07:14 AM
Colin Legg's Avatar
Colin Legg Colin Legg is offline
Out Of Office

Retired Moderator
* Expert *
 
Join Date: Mar 2005
Location: London, UK
Posts: 3,398
Default Delete Rows If A Column Does Not Contain One Of Several Values

This is an adaptation of the Range.ColumnDifferences() example a couple of posts ago.

Code:
Sub Example1()

    Dim varList As Variant
    Dim lngLastRow As Long, lngCounter As Long
    Dim rngToCheck As Range, rngFound As Range
    Dim rngToDelete As Range, rngDifferences As Range
    Dim blnFound As Boolean
    
    Application.ScreenUpdating = False
    
    With Sheet1
        lngLastRow = GetLastRow(.Cells)
        
        'we don't want to delete our header row
        Set rngToCheck = .Range("A2:A" & lngLastRow)
    End With
    
    If lngLastRow > 1 Then
        
        With rngToCheck
            
            varList = VBA.Array("Here", "There", "Everywhere")
            
            For lngCounter = LBound(varList) To UBound(varList)
 
                Set rngFound = .Find( _
                                        What:=varList(lngCounter), _
                                        Lookat:=xlWhole, _
                                        SearchOrder:=xlByRows, _
                                        SearchDirection:=xlNext, _
                                        MatchCase:=True)
 
                'check if we found a value we want to keep
                If Not rngFound Is Nothing Then
                
                    blnFound = True
                    
                    'if there are no cells with a different value then
                    'we will get an error
                    On Error Resume Next
                    Set rngDifferences = .ColumnDifferences(Comparison:=rngFound)
                    On Error GoTo 0
                        
                    If Not rngDifferences Is Nothing Then
                        If rngToDelete Is Nothing Then
                            Set rngToDelete = rngDifferences
                        Else
                            Set rngToDelete = Application.Intersect(rngToDelete, rngDifferences)
                        End If
                    End If
 
                End If
                 
            Next lngCounter
        End With
            
        If rngToDelete Is Nothing Then
            If Not blnFound Then rngToCheck.EntireRow.Delete
        Else
            rngToDelete.EntireRow.Delete
        End If
    End If
 
    Application.ScreenUpdating = True
    
End Sub
If you want blanks to be exceptioned then amend the array:
Code:
varList = VBA.Array("Here", "There", "Everywhere","")

Last edited by Colin Legg; 12-16-2010 at 05:06 PM. Reason: corrected small bug
Reply With Quote
  #8  
Old 09-24-2008, 07:36 AM
Colin Legg's Avatar
Colin Legg Colin Legg is offline
Out Of Office

Retired Moderator
* Expert *
 
Join Date: Mar 2005
Location: London, UK
Posts: 3,398
Default Delete Rows From A Worksheet Based On Multiple Conditions

If we are checking for several keywords in an entire worksheet, the range object's find method is likely to be best way. Again, we prefer to delete all the rows in one go at the end so that the routine runs more quickly.
Code:
Sub Example1()

    Dim varList As Variant
    Dim lngarrCounter As Long
    Dim rngFound As Range, rngToDelete As Range
    Dim strFirstAddress As String
    
    Application.ScreenUpdating = False
    
    varList = VBA.Array("Here", "There", "Everywhere")
    
    For lngarrCounter = LBound(varList) To UBound(varList)
        With Sheet1.UsedRange
            Set rngFound = .Find( _
                                What:=varList(lngarrCounter), _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True)
            
            If Not rngFound Is Nothing Then
                strFirstAddress = rngFound.Address
                
                If rngToDelete Is Nothing Then
                    Set rngToDelete = rngFound
                Else
                    If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    End If
                End If
                
                Set rngFound = .FindNext(After:=rngFound)
                
                Do Until rngFound.Address = strFirstAddress
                    If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    End If
                    Set rngFound = .FindNext(After:=rngFound)
                Loop
            End If
        End With
    Next lngarrCounter
    
    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

    Application.ScreenUpdating = True
    
End Sub

Last edited by Colin Legg; 12-16-2010 at 05:08 PM.
Reply With Quote
  #9  
Old 09-24-2008, 07:41 AM
Colin Legg's Avatar
Colin Legg Colin Legg is offline
Out Of Office

Retired Moderator
* Expert *
 
Join Date: Mar 2005
Location: London, UK
Posts: 3,398
Default Delete Rows From A Workbook Based On Multiple Conditions

We expand our way up the object heirachy and arrive at the workbook level. Same idea as the previous post except that we introduce an additional For Each... Next Loop to cycle through the Worksheets collection. Note that we use the worksheets collection in preference to the sheets collection because the sheets are not necessarily worksheets and therefore might not have ranges!

Code:
Sub Example1()

    Dim varList As Variant
    Dim lngarrCounter As Long
    Dim wstItem As Worksheet
    Dim rngFound As Range, rngToDelete As Range
    Dim strFirstAddress As String
    
    Application.ScreenUpdating = False
    
    varList = VBA.Array("Here", "There", "Everywhere")
    
    For Each wstItem In Workbooks(1).Worksheets
        For lngarrCounter = LBound(varList) To UBound(varList)
            With wstItem.UsedRange
                Set rngFound = .Find( _
                                    What:=varList(lngarrCounter), _
                                    Lookat:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=True)
                
                If Not rngFound Is Nothing Then
                    strFirstAddress = rngFound.Address
                    
                    If rngToDelete Is Nothing Then
                        Set rngToDelete = rngFound
                    Else
                        'we can only have one range reference per row.
                        If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                            Set rngToDelete = Application.Union(rngToDelete, rngFound)
                        End If
                    End If
                    
                    Set rngFound = .FindNext(After:=rngFound)
                    
                    Do Until rngFound.Address = strFirstAddress
                        If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                            Set rngToDelete = Application.Union(rngToDelete, rngFound)
                        End If
                        Set rngFound = .FindNext(After:=rngFound)
                    Loop
                End If
            End With
        Next lngarrCounter
        
        If Not rngToDelete Is Nothing Then
            'we can't use a non-contiguous 3D range, so we have to delete
            'before looping onto the next worksheet
            rngToDelete.EntireRow.Delete

            'the referenced range has been disposed; we have to 'clear' the reference to it
            'before we iterate onto the next worksheet
            Set rngToDelete = Nothing
        End If
    Next wstItem

    Application.ScreenUpdating = True
    
End Sub
As noted by the comments in the code, we have to delete the rows and clear the rngToDelete reference on a worksheet by worksheet basis.

Last edited by Colin Legg; 12-16-2010 at 05:12 PM.
Reply With Quote
Reply

Tags
columndifferences, conditionally delete rows, delete cells, delete empty rows, delete rows, excel, limitations, specialcells, vba


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Advertisement:





Free Publications
The ASP.NET 2.0 Anthology
101 Essential Tips, Tricks & Hacks - Free 156 Page Preview. Learn the most practical features and best approaches for ASP.NET.
subscribe
Programmers Heaven C# School Book -Free 338 Page eBook
The Programmers Heaven C# School book covers the .NET framework and the C# language.
subscribe
Build Your Own ASP.NET 3.5 Web Site Using C# & VB, 3rd Edition - Free 219 Page Preview!
This comprehensive step-by-step guide will help get your database-driven ASP.NET web site up and running in no time..
subscribe
 
 
-->