Code is running really slow, and inaccurately...

[wpryan]

Hi All,

I am trying to remove rows where the contents of column G = zero. The code is:

    Dim arr As Variant: arr = shAnalyzedData.Range("A2:G722")
    Dim i As Long
    For i = UBound(arr, 1) To LBound(arr, 1) Step -1
        If arr(i, 7) = 0 Then
            Rows(i).Delete
        End If
    Next i

First, the code takes a long time to run through the array, and second, it keeps the first instance where the contents of G is not zero (which happens to be in row 722), but deletes all rows above where the contents of column G = zero.
...so this leaves two questions... is there a faster way to do what I want, and why are the incorrect rows being deleted?

 

[wpryan]

@wpryan Fluff's code is the code for Option b which involves flagging rows for deletion, sorting those rows so they are in a contiguous block and then deleting that block of rows.

For option a, there is no Filter array function that works on a 2 dimensional array and the filtering is done by looping and moving the data that meets the criteria into a new array.
Below is the code for Option a

Sub FilterArrayDelete()
    Dim shAnalyzedData As Worksheet
    Dim rng As Range
    Dim arrSrc As Variant, arrDest As Variant
    Dim lastrow As Long, i As Long, jDest As Long, iCol As Long
  
    ' Load original data into an array
    Set shAnalyzedData = ActiveSheet
    With shAnalyzedData
        lastrow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rng = .Range("A2:G" & lastrow)
        arrSrc = rng.Value2
    End With
  
    ' Size filtered output array to maximum size being original array
    ReDim arrDest(1 To UBound(arrSrc, 1), 1 To UBound(arrSrc, 2))
  
    ' Transfer data that meets criteria into output array
    For i = 1 To UBound(arrSrc)
        If arrSrc(i, 7) <> 0 Then
            jDest = jDest + 1
            For iCol = 1 To UBound(arrSrc, 2)
                arrDest(jDest, iCol) = arrSrc(i, iCol)
            Next iCol
        End If
    Next i
  
    rng.ClearContents               ' Clear original data
    Set rng = rng.Resize(jDest)     ' Size to number of qualifying items
    rng = arrDest                   ' Write result to sheet
End Sub

@wpryan Fluff's code is the code for Option b which involves flagging rows for deletion, sorting those rows so they are in a contiguous block and then deleting that block of rows.

For option a, there is no Filter array function that works on a 2 dimensional array and the filtering is done by looping and moving the data that meets the criteria into a new array.
Below is the code for Option a

Sub FilterArrayDelete()
    Dim shAnalyzedData As Worksheet
    Dim rng As Range
    Dim arrSrc As Variant, arrDest As Variant
    Dim lastrow As Long, i As Long, jDest As Long, iCol As Long
   
    ' Load original data into an array
    Set shAnalyzedData = ActiveSheet
    With shAnalyzedData
        lastrow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rng = .Range("A2:G" & lastrow)
        arrSrc = rng.Value2
    End With
   
    ' Size filtered output array to maximum size being original array
    ReDim arrDest(1 To UBound(arrSrc, 1), 1 To UBound(arrSrc, 2))
   
    ' Transfer data that meets criteria into output array
    For i = 1 To UBound(arrSrc)
        If arrSrc(i, 7) <> 0 Then
            jDest = jDest + 1
            For iCol = 1 To UBound(arrSrc, 2)
                arrDest(jDest, iCol) = arrSrc(i, iCol)
            Next iCol
        End If
    Next i
   
    rng.ClearContents               ' Clear original data
    Set rng = rng.Resize(jDest)     ' Size to number of qualifying items
    rng = arrDest                   ' Write result to sheet
End Sub

This is working well, and fast! Thanks! I'll mark it as the solution because the code kindly supplied by Fluff is not tested, and the file will be distributed to people who don't have Office 365...

 

[Fluff]

the code kindly supplied by Fluff is not tested

Well thanks for wasting my time.

 

[Alex Blakenburg]

Fluff's code in post#8 is one of the fastest way of deleting rows based on using criteria if you have formulas and/or row specific formatting applied and works on all versions of Excel.
The only formatting that won't follow the sorted rows are borders and row specific row heights.

It would be well worth your while to test it out, and even if you don't use it for this application, tuck it away for when you want to do a similar thing in the future and have the additional requirments of formulas and formatting.