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?

 

[shinigamilight]

If you're just trying to search the contents in column G why are you putting the range from A2 in the array?
Give this a try

Sub wpryan()
        Dim lr As Long
        lr = Range("G" & Rows.Count).End(xlUp).Row
        Dim k As Long
        
        For k = lr To 2 Step -1
               If IsEmpty(Range("G" & k).Value) = False And Range("G" & k).Value = 0 Then Range("G" & k).EntireRow.Delete
        Next k
End Sub

 

[Alex Blakenburg]

and why are the incorrect rows being deleted?

If you want the array counter to match the row number you need to load the range starting at row 1 (not 2 like you have).
In your code item 1 in the array is actually row 2 on the sheet.

There are a number of ways to speed it up especially if you have a lot of data.
a) If you don't have any formulas or row specific formatting then you create a new array with the data you want to keep, delete all the existing data then write out the array.
b) If you do have formulas and row specific formatting (but not borders), you can flag the items for deleting using an array then sort the data rows to be deleted to be in one block then delete those rows.

 

[wpryan]

If you're just trying to search the contents in column G why are you putting the range from A2 in the array?
Give this a try

Sub wpryan()
        Dim lr As Long
        lr = Range("G" & Rows.Count).End(xlUp).Row
        Dim k As Long
       
        For k = lr To 2 Step -1
               If IsEmpty(Range("G" & k).Value) = False And Range("G" & k).Value = 0 Then Range("G" & k).EntireRow.Delete
        Next k
End Sub

Hi there, thanks for your reply. Good point, I missed the fact that I was searching all data, not just the data from column G. However, even if it gives the correct result it is still super slow...

 

[wpryan]

If you want the array counter to match the row number you need to load the range starting at row 1 (not 2 like you have).
In your code item 1 in the array is actually row 2 on the sheet.

There are a number of ways to speed it up especially if you have a lot of data.
a) If you don't have any formulas or row specific formatting then you create a new array with the data you want to keep, delete all the existing data then write out the array.
b) If you do have formulas and row specific formatting (but not borders), you can flag the items for deleting using an array then sort the data rows to be deleted to be in one block then delete those rows.

Hi Alex, thanks for your suggestion. I was actually searching for a way to filter the data into an array but couldn't figure out how to do it, as you suggested in option a. There are no formulas or formatting in the data set.

 

[Fluff]

Could you have blank cells in col G, if so should they be deleted?

 

[wpryan]

Could you have blank cells in col G, if so should they be deleted?

Hi (again) Fluff, column G will not have blank cells in the indicated range (G1:G722)

 

[Fluff]

Ok, how about

Sub wpryan()
   Dim Ary As Variant, Nary As Variant
   Dim NxtCol As Long, r As Long, c As Long
   
   Application.ScreenUpdating = False
   NxtCol = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious, , , False).Column + 1
   Ary = Range("G2", Range("G" & Rows.count).End(xlUp)).Value2
   ReDim Nary(1 To UBound(Ary), 1 To 1)
   
   For r = 1 To UBound(Ary)
      If Ary(r, 1) = 0 Then
         Nary(r, 1) = 0
         c = c + 1
      Else
         Nary(r, 1) = r
      End If
   Next r
   If c > 0 Then
      With Range("A2").Resize(UBound(Ary), NxtCol)
         .Columns(NxtCol).Value = Nary
         .Sort Key1:=.Columns(NxtCol), Order1:=xlAscending, Header:=xlNo
         .Resize(c).EntireRow.Delete
         .Columns(NxtCol).ClearContents
      End With
   End If
End Sub

 

[Alex Blakenburg]

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

I was actually searching for a way to filter the data into an array but couldn't figure out how to do it, as you suggested in option a.

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

 

[Fluff]

As the OP has 365 another option is

Sub wpryan2()
   Dim Ary As Variant
   
   With Range("A2:G" & Range("G" & Rows.count).End(xlUp).Row)
      Ary = Evaluate("filter(" & .Address & "," & .Columns(7).Address & "<>0)")
      .ClearContents
      .Resize(UBound(Ary)).Value = Ary
   End With
End Sub