简体   繁体   中英

VBA_Loop through empty rows in a range and delete all in a batch (one-line)

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM