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