Choking when delete large # of rows from a sheet

Question

I have a sub which adds a column from a table to an array (strArr), loops through the array to determine which rows to delete, and adds the row I want to delete to another array (deleteArr). I then loop in reverse order to delete the row. It seems to work fine for a small number of rows, but completely hangs on rows where I have a few thousand matches in deleteArr, even if I let it run forever. Does anyone have an idea what is going on here?

Public Sub DeleteRows(ByVal surveyString As String)

    Dim surveyArr() As String
    Dim retireArr() As String
    Dim strArr() As Variant
    Dim deleteArr() As Variant
    Dim totalRows As Long
    Dim tRange As String
    Dim x As Long
    Dim y As Long
    Dim ws As Worksheet

    'Split up fields to delete received from listBox
    If surveyString <> "" Then
        surveyArr = Split(surveyString, "|")
    End If

    totalRows = Sheets("Employee").Rows(Rows.Count).End(xlUp).Row
    tRange = "L2:L" & CStr(totalRows)
    strArr = Sheets("Employee").Range(tRange).Value
    x = 0

    If surveyString <> "" Then
        'determine which rows match and need to be deleted
        'the value in deleteArr is the row to delete
        For i = 1 To UBound(strArr)
            For i2 = 0 To UBound(surveyArr)
                If strArr(i, 1) = surveyArr(i2) Then
                    'resize the array and add the row value of what we want to delete
                    ReDim Preserve deleteArr(0 To x)
                    deleteArr(x) = i + 1
                    x = x + 1
                End If
            Next i2
        Next i
        'delete the row in reverse order so no rows are skipped
        Set ws = Sheets("Employee")
        y = UBound(deleteArr)
        For i = totalRows To 2 Step -1
            If i = deleteArr(y) Then
                ws.Rows(i).EntireRow.Delete
                If y > 0 Then
                    y = y - 1
                End If
            End If
        Next i
    End If

End Sub

Here's a useful thread with some approaches to speed this up. https://stackoverflow.com/questions/30959315/excel-vba-performance-1-million-rows-delete-rows-containing-a-value-in-less — Ryan Wildry, Nov 08 '19 at 15:17
Interesting. I tried the recommended solution that uses FastWB and filters the range and copies to a new tab, but I get "Error -2147417848 Automation error The object invoked hasdisconnected from its clients". I'm not sure what could be causing this — Sudio, Nov 08 '19 at 16:14
How about this approach: Have a temp column with a formula that maybe returns `True` or `False` (**`True`** = row to delete). Then use VBA to perform a filter and then delete all visible rows — Zac, Nov 08 '19 at 16:33

Ryan Wildry · Accepted Answer · 2019-11-08T18:20:08.977

You could try to union a range of all rows you want to delete, then delete in one shot. Code is untested, hopefully this points you in the right direction.

Public Sub DeleteRows(ByVal surveyString As String)

    Dim surveyArr() As String
    Dim retireArr() As String
    Dim strArr() As Variant
    Dim deleteArr() As Variant
    Dim totalRows As Long
    Dim tRange As String
    Dim x As Long
    Dim y As Long
    Dim ws As Worksheet
    Dim UnionRange As Range

    'Split up fields to delete received from listBox
    If surveyString <> "" Then
        surveyArr = Split(surveyString, "|")
    End If

    totalRows = Sheets("Employee").Rows(Rows.Count).End(xlUp).Row
    tRange = "L2:L" & CStr(totalRows)
    strArr = Sheets("Employee").Range(tRange).Value
    Set ws = Sheets("Employee")

    If surveyString <> "" Then
        'determine which rows match and need to be deleted
        'the value in deleteArr is the row to delete
        For i = 1 To UBound(strArr)
            For i2 = 0 To UBound(surveyArr)
                If strArr(i, 1) = surveyArr(i2) Then
                    If UnionRange Is Nothing Then
                        Set UnionRange = ws.Rows(i)
                    Else
                        Set UnionRange = Union(UnionRange, ws.Rows(i))
                    End If
                End if
            Next
        Next

        If Not UnionRange Is Nothing Then UnionRange.EntireRow.Delete

    End If

End Sub

Interesting suggestion. It doesn't like the "Set UnionRange = Union(UnionRange, ws.Rows(i))" (invalid procedure call). I'm not familiar with Union, is that how it's used? — Sudio, Nov 08 '19 at 18:10
Union joins two or more range objects together. Reference --> https://learn.microsoft.com/en-us/office/vba/api/excel.application.union I believe there was an error in the code before, have another try with the revised code. I had to check if the range was initially `Nothing` — Ryan Wildry, Nov 08 '19 at 18:21
Thanks Ryan. Tried the code and it does seem to work. It seems like the quickest way to delete thousands of rows is by using a table filter on the rows and copy to a new sheet. The issue I had with the proposed answer at: https://stackoverflow.com/questions/30959315/excel-vba-performance-1-million-rows-delete-rows-containing-a-value-in-less was that I had named ranges that I had to keep. You have my upvote and a green check mark =D — Sudio, Nov 08 '19 at 18:39

Choking when delete large # of rows from a sheet

1 Answers1