code doesn't work

[ksnapp]

I need to delete any rows if they meet the following criteria

column D = 0

column C <> "TOTAL"

if column A = empty

then delete the row

but

if column A <> empty
then it needs to have its value moved one cell down and then delete th
row.

Here is what I tried and it leaves a bunch and has to be run severa
times


Sub Delete_if_zero_and_not_total()

Dim rw
rw = Cells(Rows.Count, 4).End(xlUp).Row
Range("D2", Cells(rw, 4)).Select
For Each CELL In Selection

Dim A As Single
Dim B As String
Dim C As String

A = CELL.Value
B = CELL.Offset(0, -1).Value
C = CELL.Offset(0, -3).Value

If A = Empty And B <> "TOTAL" And C = Empty Then
CELL.EntireRow.Delete
End If

If A = Empty And B <> "TOTAL" And C <> Empty then

CELL.Offset(1, -3).Value = C
CELL.EntireRow.Delete
End If

Next
End Su

 

[JE McGimpsey]

Boy, this sounds familiar...

One way:

Public Sub Delete_if_zero_and_not_total()
Dim rCell As Range
Dim rDelete As Range

For Each rCell In Range("A2:A" & _
Cells(Rows.Count, 4).End(xlUp).Row)
With rCell.Resize(1, 4)
If .Item(4).Value = 0 Then
If .Item(3).Value <> "TOTAL" Then
If IsEmpty(.Item(1).Value) Then _
.Offset(1, 0).Resize(1, 1).Value = _
.Item(1).Value
If rDelete Is Nothing Then
Set rDelete = rCell
Else
Set rDelete = Union(rDelete, rCell)
End If
End If
End If
End With
Next rCell
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub