Search code examples
excelvbadelete-row

Excel VBA Store row numbers in Array and delete multiple rows at once


I'm trying to delete all rows on my worksheet that have a unique value in column B.

I know this can be done with a filter or conditioned formatting, but I would like to know if the following is possible as well, since it could be useful in other situations:

I want to loop through all rows and store the row number in an Array if the row has a unique value in column B. Then delete all the rows whose number is stored in the Array in one single action.

The reasoning for storing the row numbers in an Array instead of deleting the desired rows in the loop is to reduce runtime.

My data varies in number of rows but is always in column A:K and it always begins on row 6.

Below is the code I've written with inspiration from the following links:
Dynamically adding values to the array on the go.
Deleting rows whose number is stored in array in one single action (see Tim Williams answer).

I get the error message: Run-time error '5': Invalid procedure call or Argument

Sub DeleteRows()
Dim ws4 As Worksheet: Set ws4 = Worksheets("Sheet1")
Dim LastRow As Long
Dim CurrentRow As Long
Dim GroupValue
Dim GroupTotal As Long
Dim MyArray()
Dim y As Long

Application.ScreenUpdating = False
ws4.Activate

GroupValue = ws4.Range("B6").Value ' Sets the first GroupValue
CurrentRow = 6 ' Sets the starting row
y = 0
LastRow = ws4.Cells(Rows.Count, "B").End(xlUp).Row

    For x = 1 To LastRow

        GroupTotal=Application.WorksheetFunction.CountIf(Range("B6:B"&LastRow), _
            GroupValue) ' Searches for the GroupValue and finds number of matches
        If GroupTotal = 1 Then ' If GroupTotal = 1 then add the row# to the array
            ReDim Preserve MyArray(y)
            MyArray(y) = CurrentRow
            y = y + 1
        End If

        CurrentRow = CurrentRow + GroupTotal 'set the next row to work with
        GroupValue = Range("B" & CurrentRow).Value 'set next GroupValue to find

        If GroupValue = "" Then ' Checks to see if the loop can stop
            Exit For
        End If

    Next x

'***This should delete all the desired rows but instead produces the error.***
ws4.Range("B" & Join(MyArray, ",B")).EntireRow.Delete
Application.ScreenUpdating = True

End Sub

I've researched for hours and tried to manipulate the code with no luck.


Solution

  • Use a variable defined as a Range and Union each row to it.
    In the example below MyArray is the array of row numbers that should be deleted.

    Public Sub Test()
    
        Dim MyArray() As Variant
    
        MyArray = Array(2, 4, 5, 8, 10, 15)
    
        DeleteRows MyArray
    
    End Sub
    
    Public Sub DeleteRows(RowNumbers As Variant, Optional SheetName As String = "")
    
        Dim wrkSht As Worksheet
        Dim rRange As Range
        Dim x As Long
    
        On Error GoTo ERROR_HANDLER
    
        If SheetName = "" Then
            Set wrkSht = ActiveSheet
        Else
            Set wrkSht = ThisWorkbook.Worksheets(SheetName)
        End If
    
        For x = LBound(RowNumbers) To UBound(RowNumbers)
            If rRange Is Nothing Then
                Set rRange = wrkSht.Rows(RowNumbers(x))
            Else
                Set rRange = Union(rRange, wrkSht.Rows(RowNumbers(x)))
            End If
        Next x
    
        If Not rRange Is Nothing Then rRange.Delete
    
        On Error GoTo 0
    
    Exit Sub
    
    ERROR_HANDLER:
        Select Case Err.Number
    
            Case Else
                MsgBox "Error " & Err.Number & vbCr & _
                    " (" & Err.Description & ") in procedure DeleteColumns."
                Err.Clear
                Application.EnableEvents = True
        End Select
    
    End Sub  
    

    Edit
    The Test procedure can be replaced with any code that creates an array of row numbers. The array is then passed to the DeleteRows procedure. You could also pass it a sheet name to delete the rows from: DeleteRows MyArray, "Sheet2".

    The DeleteRows procedure sets up the variables, turns error checking on and then checks if a sheet name was passed to it. It then sets a reference to either the active sheet or the named sheet. You could also check if the passed sheet actually exists here.

    Next a loop starts going from the first to last element of the array. The first is usually 0 so you could replace LBOUND(RowNumbers) with 0.

    rRange is the variable that's going to hold the row references to delete and Union won't work if it doesn't already hold a range reference.
    On the first pass of the loop it won't hold a reference so will be nothing and the first row in the array will be set as the first row reference on the sheet held in wrkSht.
    On subsequent passes rRange will already hold a reference so the next row will be unioned to it.
    Those two decisions are made in an IF...END IF block seperated by an ELSE statement.

    After the loop has finished a single line IF statement - no END IF required on single line - checks if rRange holds any references. If it does then those rows are deleted.

    The procedure exits the main body of code, deals with the error handling and then ends.