macro to delete rows with zero value

[Robert]

Hello,

I need some help in writing a macro to look at a column of
values and when it gets to a cell with zero value I want
to delete all rows from there down. The data will be
sorted in decending order so all rows after the first row
that has a zero value will also have zero value.

For example, with the data below: I want to look at column
D (which would have various numbers of rows) and once
there is a value of zero as in row 5, I want all rows from
row 5 to the end deleted.

A B C D
1 5000111017 510100 1000.000
2 5000111017 510100 2030.000
3 5000111017 510100 1200.000
4 5000111017 510100 3020.000
5 5000111017 510100 0.000
6 5000111017 510100 0.000
7 5000111017 510100 0.000
8 5000111017 510100 0.000
9 5000111017 510100 0.000

Thank you in advance for helping me write this macro.

 

[Ken Wright]

Sub DeleteZeroDown()

Dim LastRw As Long
Dim Rng As Range
Dim Cel As Range

Application.ScreenUpdating = False

LastRw = Cells(Rows.Count, "D").End(xlUp).Row
Set Rng = Range(Cells(1, "D"), Cells(LastRw, "D"))

For x = 1 To Rng.Rows.Count
For Each Cel In Rng.Rows(x)
If Cel.Value = 0 Then
Cel.Resize(LastRw - x + 1, 1).EntireRow.Delete
Exit Sub
End If
Next Cel
Next x

Application.ScreenUpdating = True

End Sub

 

[Don Guillett]

try

Sub findanddelete()
x = Columns(5).Find(0).Row
y = Cells(Rows.Count, 5).End(xlUp).Row
Rows(x & ":" & y).Delete
End Sub

 

[Robert]

thank you very much! That worked perfectly

-----Original Message-----
Sub DeleteZeroDown()

Dim LastRw As Long
Dim Rng As Range
Dim Cel As Range

Application.ScreenUpdating = False

LastRw = Cells(Rows.Count, "D").End(xlUp).Row
Set Rng = Range(Cells(1, "D"), Cells(LastRw, "D"))

For x = 1 To Rng.Rows.Count
For Each Cel In Rng.Rows(x)
If Cel.Value = 0 Then
Cel.Resize(LastRw - x + 1, 1).EntireRow.Delete
Exit Sub
End If
Next Cel
Next x

Application.ScreenUpdating = True

End Sub


--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 00/02/03

---------------------------------------------------------- ------------------
It's easier to beg forgiveness than ask permission
---------------------------------------------------------- ------------------






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.560 / Virus Database: 352 - Release Date: 08/01/2004


.

 

[Ken Wright]

My pleasure, and thanks for letting me know.