Deleting rows based on cell is empty

  • Thread starter Thread starter Todd
  • Start date Start date
T

Todd

Hello I would like to modify the 2nd macro that works and
hides rows by a cell in "column b" being empty to the 1st
macro which deletes rows based on cell in "column b" being
empty.

Please note I will have rows above and bleow the named
range of qty rows that need to stay. This is a parts list
sheet with profit calcs out the right hand side & I am
going to delete those parts that do not have a qty entered
in a particular column ( in this case "B")

If you do not like my barrowed macro then please suggest
something. I am also looking to delete same range same way
on another tab in the same work book but that is a nice to
have - the 1st part is the important issue).

This is first macro is the modified to delete macro:

Sub delete_zero_qty_items()
ActiveSheet.Unprotect
'qty_range is a named range in column b that goes from
B25 to B110
For Each c In Range("qty_range")
If IsEmpty(c.Value) Then
c.EntireRow.Delete
End If
Next c
Range("D8").Select
ActiveSheet.Unprotect
End Sub

This second macro is the original macro that I tried to
change.

Sub hide_zero_qty_rows_original_macro()
ActiveSheet.Unprotect
For Each c In Range("qty range")
If IsEmpty(c.Value) Then
c.EntireRow.Hidden = True
End If
Next c
Range("D8").Select
ActiveSheet.Unprotect
End Sub


Thank yo for your time
 
Hi
try (not fully tested)

Sub delete_zero_qty_rows_original_macro()
dim last_row as long
dim rng as range
Dim row_index
ActiveSheet.Unprotect
set rng = Range("qty range")
last_row = rng.rows.count + rng.row -1

For row_index = last_row to 1 rng.row step -1
If IsEmpty(cells(row_index,"B").Value) Then
cells(row_index,"B").entirerow.delete
End If
Next
Range("D8").Select
ActiveSheet.Unprotect
End Sub
 
You had a stray "1" in the For command and missed the underscore in the
qty_range.

Sub delete_zero_qty_rows_original_macro()
dim last_row as long
Dim rng as Range
Dim row_index as Long
ActiveSheet.Unprotect
set rng = Range("qty_range")
last_row = rng.rows.count + rng.row -1

For row_index = last_row to rng.row step -1
If IsEmpty(cells(row_index,"B").Value) Then
cells(row_index,"B").entirerow.delete
End If
Next
Range("D8").Select
ActiveSheet.Unprotect
End Sub

Another approach:

Sub Deleteemptyrows()
dim rng as Range
set rng = Range("qty_range")
set rng = intersect(rng.Entirerow,columns(2)).Cells
set rng = rng.Specialcells(xlBlanks)
rng.Entirerow.Delete
End Sub
 
Thanks for the suggestion - very interesting you are out
of Frankfurt - I work for a German company but in USA


One question I see near bottom you have Range
("D8").s;ect - what does this mean "D8"

Todd Frisch (e-mail address removed)
 
Hi tom
thanks for that. I'm currently re-installing Office so the VBA editor
wasn't available :-)
Thanks for the correction and of course your approach is neat (I always
forget the SpecialCells command)
 
Thank you Tom & Frank both for your time

I ran the Tom's macro and It gave me ref. eroors in the
formaul fields in the remaining rows BUT I MADE A MISTAKE
when I said column B - it was really column C so I took a
guess and changed the 2 to a 3 ( 4th row from bottom and
it worked with no formula errors.

Also Can a second non adjacent range be added to this to
go down the sheet may a few rows and then delete a second
and even a third named range.

This is the macro now:

Sub Deleteemptyrows()
Dim rng As Range
Set rng = Range("qty_range")
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
Set rng = rng.SpecialCells(xlBlanks)
rng.EntireRow.Delete
End Sub
 
Assuming you mean you have several sections of Column C that you would like
to examine and they have separate range names

Sub Deleteemptyrows()
Dim varr as Variant
Dim rng As Range
varr = Array("qty_range","qty_range1", "qty_range2")
for i = lbound(varr) to ubound(varr)
Set rng = Range(varr(i))
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
Set rng = rng.SpecialCells(xlBlanks)
rng.EntireRow.Delete
Next
End Sub

or

Sub Deleteemptyrows()
Dim varr as Variant
Dim rng As Range
Set rng = Union(Range("qty_range"), _
Range("qty_range1"), Range("qty_range2"))
Set rng = Range(varr(i))
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
Set rng = rng.SpecialCells(xlBlanks)
rng.EntireRow.Delete
End Sub
 
wow! thanks

But May I impose yet further and ask how to handle when a
user pushes the button a second time and gets the error
message
run time error 1004
no cells where found

there could be a message box with a click close , there
could be a disapaerring button , it could jsut sit there
and do nothing - what ever is quickest to suggest and
simpliest for me (novice)
 
Sub Deleteemptyrows()
Dim varr as Variant
Dim rng As Range
varr = Array("qty_range","qty_range1", "qty_range2")
for i = lbound(varr) to ubound(varr)
Set rng = Range(varr(i))
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
On Error Resume Next
Set rng = rng.SpecialCells(xlBlanks)
rng.EntireRow.Delete
On Error goto 0
Next
End Sub

or

Sub Deleteemptyrows()
Dim varr as Variant
Dim rng As Range
Set rng = Union(Range("qty_range"), _
Range("qty_range1"), Range("qty_range2"))
Set rng = Range(varr(i))
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
On Error Resume Next
Set rng = rng.SpecialCells(xlBlanks)
rng.EntireRow.Delete
On Error goto 0
End Sub

so nest the SpecialCells command and the delete command within

On Error Resume Next

On Error goto 0
 
Thanks you very much for the amount of time you spent on
this - with the variants on the theme that you gave me I
can use this and hopefully modify it to do some other
tasks.

Todd
 
I got greedy Tom and I need to take a step back

I ran into some problems withthat last vba example

If you push the button again it deletes the rows with
numbers in coloumn c (3) ( 1st macro on your reply

SO lets try to get me sharp on the basics - Can I get the
below macro for one range to not give me a 1004 error box
when I push the button again when there is no blank cells.

It can be a message box that there is no blank cellS OR
JUST "NOTHING HAPPENS"

Sub Deleteemptyrows()
Dim rng As Range
Set rng = Range("qty_range")
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
Set rng = rng.SpecialCells(xlBlanks)
rng.EntireRow.Delete
End Sub

I will use the multi range code when I figure it out - the
problem is that you can't use it when you don't have a
multi range.

Thanks allot!

Thanks Much
 
The error is caused by Specialcells(xlBlanks). If there are no blanks, it
raises and error - so just as in the other two procedures you just need to
handle the error.

Sub Deleteemptyrows()
Dim rng As Range
Set rng = Range("qty_range")
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
On Error Resume Next
Set rng = rng.SpecialCells(xlBlanks)
rng.EntireRow.Delete
' optional
if err.Number <> 0 then
msgbox "No rows had empty cells"
end if
On Error goto 0
End Sub
 
I ran the single range macro and it deleted my blank rows -
then I pushed the button again and it deleted everything
in range.

so I tried something - I Placed a "" instead of zero on
your line of code.

If Err.Number <> "" Then

it runs the macro again if there is only populated cells
in column but does nothing to them ( it works!)

if I decide to delete some more numbers it takes out those
rows and leaves the rest ( correctly so ).

I am getting no mesage box under any circumstances ( not a
big deal).

I did not get a change to try the multi range code yet.

Thanks for the time.
 
My fault, - I didn't focus on the first part of the macro, but only the
problem. Simply using another range for the specialcells assignment should
correct the problem. Changing err.Number <> "" should have no effect on
what gets deleted. The other two would have the same problem. See
corrections.

Sub Deleteemptyrows()
Dim rng As Range
Dim rng1 as Range
Set rng = Range("qty_range")
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
Set rng1 = Nothing
On Error Resume Next
Set rng1 = rng.SpecialCells(xlBlanks)
rng1.EntireRow.Delete
' optional
if err.Number <> 0 then
msgbox "No rows had empty cells"
end if
On Error goto 0
End Sub


---------
Sub Deleteemptyrows()
Dim varr as Variant
Dim rng As Range
Dim rng1 as Range
varr = Array("qty_range","qty_range1", "qty_range2")
for i = lbound(varr) to ubound(varr)
Set rng = Range(varr(i))
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
set rng1 = Nothing
On Error Resume Next
Set rng1 = rng.SpecialCells(xlBlanks)
rng1.EntireRow.Delete
On Error goto 0
Next
End Sub

or

Sub Deleteemptyrows()
Dim varr as Variant
Dim rng As Range
Dim rng1 as Range
Set rng = Union(Range("qty_range"), _
Range("qty_range1"), Range("qty_range2"))
Set rng = Range(varr(i))
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
set rng1 = Nothing
On Error Resume Next
Set rng1 = rng.SpecialCells(xlBlanks)
rng1.EntireRow.Delete
On Error goto 0
End Sub
 
Well time thank you for the extra time and I apoligize for
dragging this out but I am close and I do not want ot
waste your time by giving up.

pasted in below is the 3 vba pieces of code.

_The single one works great thank you.

_The 1st multi works well also but added message box I
need to click ok 9 times ( I think one time for each range
to clear it)

The 2nd multi macro is not running it goives me a run time
error 1004 - WE CAN STICK WITH THE 1ST MULTI AND ALSO I
COULD LIVE WITHOUT THE MESSAGE BOX ON MULTI IF YOU WOULD
LIKE TO CALL IT A DAY ON THIS PROJECT.

I will check the post.

see code below

Sub Delete_empty_rows_fix()
Dim rng As Range
Dim rng1 As Range
Set rng = Range("qty_range")
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
Set rng1 = Nothing
On Error Resume Next
Set rng1 = rng.SpecialCells(xlBlanks)
rng1.EntireRow.Delete
' optional
If Err.Number <> 0 Then
MsgBox "No rows had empty cells"
End If
On Error GoTo 0
End Sub

Sub MULTI_Delete_empty_rows_fixed()
Dim varr As Variant
Dim rng As Range
Dim rng1 As Range
varr = Array
("qty_range_1", "qty_range_2", "qty_range_3", "qty_range_4"
, "qty_range_5", "qty_range_6", "qty_range_7", "qty_range_8
", "qty_range_9")
For i = LBound(varr) To UBound(varr)
Set rng = Range(varr(i))
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
Set rng1 = Nothing
On Error Resume Next
Set rng1 = rng.SpecialCells(xlBlanks)
rng1.EntireRow.Delete
If Err.Number <> 0 Then
MsgBox "No rows had empty cells"
End If
On Error GoTo 0
Next
End Sub

Sub M2_multi_Deleteemptyrows()
Dim varr As Variant
Dim rng As Range
Dim rng1 As Range
Set rng = Union(Range("qty_range"), _
Range("qty_range_1"), Range("qty_range_2"), Range
("qty_range_3"), Range("qty_range_4"), Range
("qty_range_5"), Range("qty_range_6"), Range
("qty_range_7"), Range("qty_range_8"), Range
("qty_range_9"))
Set rng = Range(varr(i))
Set rng = Intersect(rng.EntireRow, Columns(3)).Cells
Set rng1 = Nothing
On Error Resume Next
Set rng1 = rng.SpecialCells(xlBlanks)
rng1.EntireRow.Delete
On Error GoTo 0
End Sub

YOUR EFFORT IS MUCH APPRECIATED.

Todd
 
Back
Top