I have developed the code below which loops through usedrange , stores the row strings into an array of 20 elements, and then deletes the rows at the end, as I find this a lot quicker than a FOR or a DO loop given a large amount of rows. The code works, however, the issue lies with the fact that when the rows are written to the array element they are hard coded, and when the .DELETE method is used , the rows shift accordingly, so the numbers shift and not everything is deleted.
Is there a way to delete an array of ranges in one batch or one line, something like
Arr(drows(1 to 20)).delete
Or do I have to find an alternative?
'**** NEEDS RE-WORK --> ADJUST FOR ROWS WHEN DELETING ****'
Sub loop_it()
Dim i As Integer 'counter for array
Dim j As Integer 'counter # 2
Dim rD As Integer 'count deleted
Dim z As Integer
Dim dRows(20) As String 'will track the rows deleted1
Dim cRow As Range 'current row
Dim cSht As Worksheet
Dim uB As Integer
Set cSht = ActiveSheet 'activesheet
i = 1: j = 1: z = 1
On Error GoTo viewerr
For Each cRow In cSht.UsedRange.Rows
If WorksheetFunction.CountA(cRow.Cells) = 0 Then
If Len(dRows(i)) < 250 Then 'not to breach length
dRows(i) = dRows(i) & cRow.Row & ":" & cRow.Row & ","
rD = rD + 1 'increment # rows deleted
Else
dRows(i) = dRows(i) 'nothing
i = i + 1
End If
End If
Next cRow
uB = UBound(dRows) 'max array
For j = 1 To uB
If j <= i Then 'skip empty strings
dRows(j) = Left(dRows(j), Len(dRows(j)) - z) ' trim last comma off of string
cSht.Range(dRows(j)).Delete 'delete the rows
Else
Exit For
End If
Next j
'need to combine the text string into one array
MsgBox rD & Chr(32) & "rows deleted!", vbExclamation + vbOKOnly, "success!"
Erase dRows 'clear array
Exit Sub
viewerr:
MsgBox Err.Description & Space(2), vbCritical
Erase dRows
End Sub
This is what typically get proposed for this task here:
Sub Tester()
'...
'...
Dim rngDelete As Range
For Each cRow In cSht.UsedRange.Rows
If WorksheetFunction.CountA(cRow.Cells) = 0 Then
If rngDelete Is Nothing Then
Set rngDelete = cRow.EntireRow
Else
Set rngDelete = Application.Union(rngDelete, cRow.EntireRow)
End If
End If
Next cRow
'delete rows if any found
If Not rngDelete Is Nothing Then rngDelete.Delete
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.