Deleting Rows With VBA

A few years ago I posted a series of VBA samples on a forum which outlined different ways to delete rows in an efficient manner. The series proved to be very popular and, since that forum is now in decline, I’m going to resurrect those notes on here. The topics covered are:

  1. Delete Rows If Cells In A Certain Column Are Empty
  2. Delete Rows If Any Cells In The Row Are Empty
  3. Delete Rows If A Column Contains A Certain Value
  4. Delete Rows If A Column Does Not Contain A Certain Value
  5. Delete Rows If A Column Contains One Of Several Values
  6. Delete Rows If A Column Does Not Contain One Of Several Values
  7. Delete Rows From A Worksheet Based On Multiple Conditions
  8. Delete Rows From A Workbook Based On Multiple Conditions

The code samples will be kept as straightforward as can be: I’m not going to engineer them into a fancy class or even wrap them into generic methods (unless I’m forced to) because I want them to be directly accessible to as many users as possible. I hope you find them to be a useful reference point when you’re faced with this sort of task. Finally, a word of caution: when you run these pieces of code they will try to delete data from your workbook so please take a backup first.

Edit 26th December: A couple of blog followers suggested that these topics should be consolidated into a single post, which I’ve now done.

1. 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:

Sub Example1()

    Dim lngLastRow As Long
    Dim rngToCheck As Range

    Application.ScreenUpdating = False

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

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

            'change the "A"s to the column letter of the column you want to check
            Set rngToCheck = .Range(.Cells(1, "A"), .Cells(lngLastRow, "A"))

            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 IsEmpty(rngToCheck.Value2) Then rngToCheck.EntireRow.Delete
            End If
        End If
    End With

    Application.ScreenUpdating = True

End Sub

Public Function GetLastUsedRow( _
        ByVal rngToCheck As Range, _
        Optional lngLookIn As XlFindLookIn = xlFormulas _
                                  ) As Long

    Const strTOFIND As String = "*"

    Dim rngLast As Range

    Set rngLast = rngToCheck.Find( _
                    What:=strTOFIND, _
                    LookIn:=lngLookIn, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious)

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

End Function

Just change the sheet codename and the column letters as you need.

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 be sufficient in Excel 2007 or later – if there is a chance that the count of cells could exceed 2,147,483,647 then you should use CountLarge instead to avoid an overflow error at runtime.

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, something we have to be careful of is that SpecialCells() 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 and some good news is that this issue has been resolved in Excel 2010. A more robust solution prior to Excel 2010 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 describes this on his website.

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

Get Last Used Row

In the example used the GetLastUsedRow() function which I already described on a previous blog entry.

2. 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 Sheet1 if the ANY of the cells within columns B to E on each row are empty. Of course, the column intersect you are checking can be changed by adjusting the column letters in the code.

Sub Example1()

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

    Application.ScreenUpdating = False

    'change Sheet1 to the codename of the sheet you want to check
    With Sheet1

        'find the last row on the sheet
        lngLastRow = GetLastUsedRow(.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
            'change the "B" and "E" to suit your needs
            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 _
                Intersect(.Range("A:A"), rngToDelete.EntireRow).EntireRow.Delete
        End If
    End With

    Application.ScreenUpdating = True

End Sub

Public Function GetLastUsedRow( _
        ByVal rngToCheck As Range, _
        Optional lngLookIn As XlFindLookIn = xlFormulas _
                                  ) As Long

    Const strTOFIND As String = "*"

    Dim rngLast As Range

    Set rngLast = rngToCheck.Find( _
                    What:=strTOFIND, _
                    LookIn:=lngLookIn, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious)

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

End Function

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 the runtime error ‘Cannot use that command on overlapping selections’:

'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:

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

3. 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 has 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:

  • Deleting a row triggers an Excel recalculation which can be particularly time-consuming if there are a lot of formulas or links. This will happen even with calculations set to manual. 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.
  • 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

Sub Example1()

    Const strTOFIND As String = "Hello"

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

    Application.ScreenUpdating = False

    'change to the sheet and column you want to check
    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 = 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 has field headers.

Sub Example2()

    Const strTOFIND As String = "Hello"

    Dim lngLastRow As Long
    Dim rngToCheck As Range

    Application.ScreenUpdating = False

    'change Sheet1 to the codename of the sheet you want to check
    With Sheet1
        'find the last row in the Sheet
        lngLastRow = GetLastUsedRow(.Cells)

        'change the "A"s to the column letter you want to check
        'row 1 is assumed to be a header row
        Set rngToCheck = .Range(.Cells(1, "A"), .Cells(lngLastRow, "A"))
    End With

    If lngLastRow > 1 Then
        With rngToCheck

            'remove the autofilter if there already is one
            .Worksheet.AutoFilterMode = False

            'filter by the string we want to find
            .AutoFilter Field:=1, Criteria1:=strTOFIND

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

            'remove the autofilter
            .Worksheet.AutoFilterMode = False
        End With
    End If

    Application.ScreenUpdating = True

End Sub

Public Function GetLastUsedRow( _
        ByVal rngToCheck As Range, _
        Optional lngLookIn As XlFindLookIn = xlFormulas _
                                  ) As Long

    Const strTOFIND As String = "*"

    Dim rngLast As Range

    Set rngLast = rngToCheck.Find( _
                                What:=strTOFIND, _
                                LookIn:=lngLookIn, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious)

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

End Function

4. 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 easy enough, 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 earlier.

Sub Example1()

    Const strTOFIND As String = "Hello"

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

    Application.ScreenUpdating = False

    'change Sheet1 to the codename of the sheet you want to check
    With Sheet1
        lngLastRow = GetLastUsedRow(.Cells)

        'assume row 1 is a header row
        If lngLastRow > 1 Then

            'we don't want to delete our header row
            'so we start from row 2
            'change the column letters to suit your needs
            With .Range("A2:A" & CStr(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

Public Function GetLastUsedRow( _
        ByVal rngToCheck As Range, _
        Optional lngLookIn As XlFindLookIn = xlFormulas _
                                  ) As Long

    Const strTOFIND As String = "*"

    Dim rngLast As Range

    Set rngLast = rngToCheck.Find( _
                                What:=strTOFIND, _
                                LookIn:=lngLookIn, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious)

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

End Function

Using The Range Object’s Autofilter Method

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

Sub Example2()

    Const strTOFIND As String = "Hello"

    Dim lngLastRow As Long
    Dim rngToCheck As Range

    Application.ScreenUpdating = False

    'change Sheet1 to the codename of the sheet you want to check
    With Sheet1
        'find the last row in the sheet
        lngLastRow = GetLastUsedRow(.Cells)

        'change the "A"s to the letter of the column you want to check
        'note: row 1 is the header row
         Set rngToCheck = .Range(.Cells(1, "A"), .Cells(lngLastRow, "A"))
    End With

        'only apply the filter if there's data beyond row 1
    If lngLastRow > 1 Then
        With rngToCheck

            .Worksheet.AutoFilterMode = False

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

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

            'remove the autofilter
            .Worksheet.AutoFilterMode = False

        End With
    End If

    Application.ScreenUpdating = True

End Sub

Public Function GetLastUsedRow( _
        ByVal rngToCheck As Range, _
        Optional lngLookIn As XlFindLookIn = xlFormulas _
                                  ) As Long

    Const strTOFIND As String = "*"

    Dim rngLast As Range

    Set rngLast = rngToCheck.Find( _
                                What:=strTOFIND, _
                                LookIn:=lngLookIn, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious)

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

End Function

5. 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 example 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

Sub Example1()

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

    Application.ScreenUpdating = False

    'this is the list of words we want to find
    varList = Array("Here", "There", "Everywhere")

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

        'change to the sheet and column you want to check
        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 = Union(rngToDelete, rngFound)
                End If

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

                Do Until rngFound.Address = strFirstAddress
                    Set rngToDelete = 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.

Sub Example2()

    Dim lngLastRow As Long
    Dim rngToCheck As Range
    Dim varList As Variant

    Application.ScreenUpdating = False

    'this is the list of words we want to find
    varList = Array("Here", "There", "Everywhere")

    'change Sheet1 to the codename of the sheet you want to check
    With Sheet1
        'find the last row in column A
        'change the "A"s to the column letter you want to check
        lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngToCheck = .Range(.Cells(1, "A"), .Cells(lngLastRow, "A"))
    End With

    'assume that row 1 is a header row
    If lngLastRow > 1 Then
        With rngToCheck

            .Worksheet.AutoFilterMode = False

            .AutoFilter _
                Field:=1, _
                Criteria1:=varList, _
                Operator:=xlFilterValues

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

            'remove the autofilter
            .Worksheet.AutoFilterMode = False

        End With
    End If

    Application.ScreenUpdating = True

End Sub

6. Delete Rows If A Column Does Not Contain One Of Several Values

This is an adaptation of the Range.ColumnDifferences() example in section 4.

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

    'change Sheet1 to the codename of the sheet you want to check
    With Sheet1
        lngLastRow = GetLastUsedRow(.Cells)

        'we don't want to delete our header row so we start from row 2
        'change the A's to the column letter you want to check
        Set rngToCheck = .Range("A2:A" & CStr(lngLastRow))
    End With

    If lngLastRow > 1 Then

        With rngToCheck
            varList = 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 = 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

Public Function GetLastUsedRow( _
        ByVal rngToCheck As Range, _
        Optional lngLookIn As XlFindLookIn = xlFormulas _
                                  ) As Long

    Const strTOFIND As String = "*"

    Dim rngLast As Range

    Set rngLast = rngToCheck.Find( _
                                What:=strTOFIND, _
                                LookIn:=lngLookIn, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious)

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

End Function

If you want blanks to be retained then amend the array to this:

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

7. 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.

Sub Example1()

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

    Application.ScreenUpdating = False

    'these are the values we want to find
    varList = Array("Here", "There", "Everywhere")

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

        'change Sheet1 to the codename of the sheet you want to check
        With Sheet1.UsedRange
            Set rngFound = .Find( _
                                What:=varList(lngCounter), _
                                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 Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Union(rngToDelete, rngFound)
                    End If
                End If

                Set rngFound = .FindNext(After:=rngFound)

                Do Until rngFound.Address = strFirstAddress
                    If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Union(rngToDelete, rngFound)
                    End If
                    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

8. Delete Rows From A Workbook Based On Multiple Conditions

We expand our way up the object hierarchy and arrive at the workbook level. The approach is to loop through the Worksheets collection and delete the rows on each sheet. To do this we can adjust the method on the previous post like this:

Sub Example1()

    Dim wst As Worksheet
    Dim strarrList() As String

    ReDim strarrList(0 To 2)

    'these are the values we want to find
    strarrList(0) = "Here"
    strarrList(1) = "There"
    strarrList(2) = "Everywhere"

    Application.ScreenUpdating = False

    'this will delete rows from all worksheets in this workbook
    For Each wst In ThisWorkbook.Worksheets
        DeleteRowsFromWorksheet wst, strarrList
    Next wst

    Application.ScreenUpdating = True

End Sub

Sub DeleteRowsFromWorksheet(ByRef wstTarget As Worksheet, ByRef strarrList() As String)

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

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

        With wstTarget.UsedRange
            Set rngFound = .Find( _
                                What:=strarrList(lngCounter), _
                                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 Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Union(rngToDelete, rngFound)
                    End If
                End If

                Set rngFound = .FindNext(After:=rngFound)

                Do Until rngFound.Address = strFirstAddress
                    If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Union(rngToDelete, rngFound)
                    End If
                    Set rngFound = .FindNext(After:=rngFound)
                Loop
            End If
        End With
    Next lngCounter

    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

End Sub
Advertisements

About Colin Legg

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

15 Responses to Deleting Rows With VBA

  1. Anthony says:

    Hi Colin, this is an excellent post, thanks for the time you’ve put in here. Could you please illustrate how you would expand this to handle ‘Begins with’ or ‘Ends with’. What I am trying to do is employ a table based approach where user’s can specify fields and filter criteria’s then I will use VBA to interrogate this table calling the relevant functions like above. The final result is a parsed dataset off a user config/filter definition table

    Like

    • Colin Legg says:

      Hi Anthony,

      If you have your data structured in a proper table format then the first option you should look at is the autofilter. The autofilter is fast and, as an added bonus, has built in functionality to do the starts with/ ends with wildcard searches you require. Once you’ve filtered the rows you are interested in you can use the Range.SpecialCells() method to get a reference to them. Provided the data isn’t massive this should all work quite efficiently. There are some examples in the post which should get you started.

      Like

  2. Tony says:

    Colin, you have to modify your syntax if you have a structured table in Excel 2010
    rRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    does not work (rRange refers to an Excel 2010 structured table).

    Use the following:

    rRange.SpecialCells(xlCellTypeVisible).Rows.Delete

    Tony

    Like

  3. Colin Legg says:

    Thanks Tony, that’ll be very helpful for people reading this post who want to delete rows from tables (Listobject objects).

    Like

  4. Patti says:

    Colin,
    I’m not a programmer, but know just enough VBA to customize it to suit my needs. Your various code on deleting rows has saved me literally countless hours at work. You are a brain surgeon and thanks soooooo much for sharing your knowledge! If you didn’t, I wouldn’t have a legg to stand on :)

    Like

  5. Ricardo says:

    Hi Colin,
    thank you for the post. in topic 5 instead of varList = Array(“Here”, “There”, “Everywhere”), if i want a range list of cells what i need to to?
    i tried several things but nothing worked

    thank you for the help

    Like

    • Colin Legg says:

      Hi Ricardo,

      An efficient way would be to read the range into an array (it would be a 2D array) and then loop through the array.
      A slightly easier piece of coding (which is also slightly less efficient) is to use a For Each…Next loop to iterate through the cells in the range. Since you are deleting rows, it’d be best to put the list on a different sheet, otherwise you need to be very careful with what you’re doing. Something like this:

      Sub Example1()

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

      Application.ScreenUpdating = False

      'this is the list of words we want to find
      'probably best to put it on a different sheet!
      Set rngList = Sheet2.Range("A1:A5")

      For Each rngCell In rngList.Cells

      If Not IsEmpty(rngCell.Value2) Then

      'change to the sheet and column you want to check
      With Sheet1.Range("A:A")
      Set rngFound = .Find( _
      What:=rngCell.Value, _
      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 = Union(rngToDelete, rngFound)
      End If

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

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

      End If

      Next rngCell

      If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

      Application.ScreenUpdating = True

      End Sub

      Hope that helps,
      Colin

      Like

  6. Johann says:

    Good day Colin
    This is a wonderful site with many options to choose from. I am however struggling to with a similar problem as Ricardo, with just a different setup. My range list is on a sheet with two columns that must be true before one can delete rows from another worksheet. In Column C are names and in column D are Yes / No’s. On the summary sheet the names are in column B.

    If the range list have a No against the name then the name must be found on the summary sheet in column B and the entire row must be deleted.

    I am not very good with VBA but have tried arrays and VLookup and Match, without any success. How can I change one of your suggestions to make this work for me.

    Thanking you in anticipation.

    Like

    • Colin Legg says:

      Hi Johann,

      Using Ricardo’s solution as a starting point, I think this should get you on your way:

      Sub Example1()
      
          Dim rngFound As Range, rngToDelete As Range
          Dim vararrList() As Variant
          Dim lngRow As Long
          Dim strFirstAddress As String
          Dim varValueToFind As Variant
          Dim blnDoSearch As Boolean
      
          Application.ScreenUpdating = False
      
          'this is the list of words we want to find
          'probably best to put it on a different sheet!
          'column D contains TRUE or FALSE
          vararrList = Sheet2.Range("C1:D5").Value
      
          For lngRow = LBound(vararrList, 1) To UBound(vararrList, 1)
              
              'empty cells will be cast as False
              blnDoSearch = CBool(vararrList(lngRow, 2))
              
              If blnDoSearch Then
                  
                  varValueToFind = vararrList(lngRow, 1)
                      
                  If Not IsEmpty(varValueToFind) Then
                  
                      'change to the sheet and column you want to check
                       With Sheet1.Range("B:B")
                       
                          Set rngFound = .Find( _
                              What:=varValueToFind, _
                              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 = Union(rngToDelete, rngFound)
                              End If
              
                              strFirstAddress = rngFound.Address
                              Set rngFound = .FindNext(After:=rngFound)
              
                              Do Until rngFound.Address = strFirstAddress
                                  Set rngToDelete = Union(rngToDelete, rngFound)
                                  Set rngFound = .FindNext(After:=rngFound)
                              Loop
                          End If
                      End With
                  End If
              End If
          Next lngRow
      
          If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
      
          Application.ScreenUpdating = True
      
      End Sub
      

      Like

      • Johann says:

        Colin

        Thank you so much for the coding. I am however stuck at the b1nDoSearch function.
        CBoo1 is returning a type mismatch and nothing I am trying is correcting it. I have Dim’ed CBoo1 and b1nDoSearch separately and together as a Variant, String and as Long but without success.

        The current coding:
        Dim vararrList() As Variant
        Dim lngRow As Long
        Dim blnDoSearch As Boolean
        Dim CBoo1 As Variant

        blnDoSearch = CBool(vararrList(lngRow, 2))

        Like

      • Johann says:

        Colin

        Thank you so much for the coding.
        (Sorry for posting the initial reply to the “Comment” area on the website.)

        The following coding is however giving a “Type Mismatch” and I have tried everything I know off to correct it but without success:
        blnDoSearch = CBoo1(vararrList(lngRow, 2))

        If I scan with the mouse over the coding, then I see this:
        b1nDoSearch = False
        CBoo1 = CBoo1(vararrList(1ngRow,2))= whilst
        vararrList(1ngRow,2) gives vararrList(1ngRow,2)=”Responsible” which is the column containing the True or False.

        The current Dim settings are as follows:
        Dim vararrList() As Variant
        ‘ReDim vararrList(1 To 1)
        Dim lngRow As Long
        Dim strFirstAddress As String
        Dim varValueToFind As Variant
        Dim blnDoSearch As Boolean
        Dim CBoo1 As Variant

        What do I need to do to get past the “Type Mismatch” then?

        Thanking you in anticipation.

        Like

  7. Colin Legg says:

    Hi,

    Sorry yes, re-reading your question I see that in your spreadsheet you have the words “Yes” and “No” which are String types. In my example I used True and False which are Boolean types.

    Change:
    Dim blnDoSearch As Boolean

    to:
    Dim strDoSearch As String

    Change:

    blnDoSearch = CBool(vararrList(lngRow, 2))
    If blnDoSearch Then

    to:

    strDoSearch = CStr(vararrList(lngRow, 2))
    If UCase$(strDoSearch) = "YES" Then

    Like

  8. Andrew says:

    Colin,
    Thank you for the code. I do have one question. What modifications are required so that I can run “6. Delete Rows If A Column Does Not Contain One Of Several Values” but only in the first 10 rows of the spreadsheet that may contain hundreds of rows?

    Like

  9. Pingback: Delete Rows If All Cells In A Given Range Are Empty | RAD Excel

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