Delete Rows if Cost Code Bucket is Zero

[zb14]

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!


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

[Paul_Hossler]

Without testing, when deleting, go bottom to top




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

[zb14]

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!

[zb14]

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.

[georgiboy]

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.

[arnelgp]

you may try this:


' 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

[zb14]

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!

[zb14]

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!

[arnelgp]

:thumb

[jolivanes]

Or a different approach.

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

[zb14]

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