Delete Rows if Cost Code Bucket is Zero

Hello! I'm trying to write a macro that would eliminate any row if the amount column (D) equals zero. Here is the code I have so far. When I run it, it eliminates some of the rows but not all, and also eliminates all of the information in the first 5 rows up top, which I do not want it to do. I have attached a test file showing all information and the uploaded macro. Thank you so much for your time and effort helping me with this!

Code:

---

Sub ZeroOutRowsWhenAmountisZero()
' ZeroOutEmptyCostCodesButton Macro
Dim i As Long
    Dim arr As Variant
Set DataSheet = Sheets("Job Estimate Import")
    With DataSheet
  arr = .Range("D8:D" & FindLastRow(DataSheet, "D"))
      For i = 1 To UBound(arr)
      'Debug.Print arr (i,1)
        If arr(i, 1) = "0" Then
          Rows(i).EntireRow.Delete
        End If
  Next
End With
End Sub

---

Without testing, when deleting, go bottom to top

Code:

---

For i = UBound(arr) to 1 Step -1


---

Paul_Hossler - thank you for the suggestion! When I try it, it comes back telling me I have a syntax error. I can't figure out why but will continue to tinker with it. If you have any other thoughts I would appreciate hearing them! Thanks!

Paul - it wasn't your code it was my failure to read what you wrote. When I actually applied your code, it did work. Unfortunately, it still deletes the top 5 rows, and it also failed to delete a few of the cost codes that had "0" in the "Amount" column. Thank you for pushing the needle forward, and I'll keep working on this one. If you have any other thoughts, I'd certainly appreciate it.

I would give some thought to the data starting at row 8 and the array starting at 1.

When you delete row i on the first loop you are deleting row 1.

When you delete the row it may need to be I+7 in order to match the array to the range.

you may try this:

Code:

---

' arnelgp
Sub agpDeleteZeroRow()
    ' put the name of sheet to work here
    Const SHEET_NAME As String = "Sheet1"
    Dim iX As Long, value As Double
    iX = 8
    With Worksheets(SHEET_NAME)
        value = NZ(.Range("D" & iX), -1)
        Do While value > -1
            If value = 0 Then
                .Rows(iX & ":" & iX).Select
                Selection.Delete Shift:=xlUp
            Else
                iX = iX + 1
            End If
            value = NZ(.Range("D" & iX), -1)
        Loop
    End With
End Sub


Private Function NZ(ByVal value1 As Variant, value2 As Variant) As Variant
    Dim s As String
    s = Trim$(value1 & "")
    NZ = value1
    If Len(s) < 1 Then
        NZ = value2
    End If
End Function

---

georgiboy - great point - starting the array at 1 didn't allow for it to run correctly when the data was at 8. Definitely an issue. Thank you for pointing that out!

arnelgp -> this works perfectly! Thank you so much for this. I really appreciate it. And thank you all again for the time you put into helping this get solved!

:thumb

Or a different approach.

Code:

---

Sub Or_So_Maybe()
Dim dataArr, i As Long, rng As Range
dataArr = Sheets("Sheet1").Range("A1:D" & Cells(Rows.Count, 4).End(xlUp).Row).Value
    For i = 8 To UBound(dataArr)
        If dataArr(i, 4) = 0 Then
            If Not rng Is Nothing Then
                Set rng = Union(rng, Cells(i, 1).EntireRow)
                    Else
                Set rng = Cells(i, 1).EntireRow
            End If
        End If
    Next i
If Not rng Is Nothing Then rng.Delete Shift:=xlUp
Set rng = Nothing
End Sub

---

jolivanes - I like this as well I always appreciate the many ways you can solve an issue here! Thank you!