EntireRow.Delete only removing half of the rows

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hello.. The following loop is only deleting half of the rows it should be
targeting. It deletes from the bottom of the selection up, but only half of
the records. If I back up and step into it again, it deletes half again of
the remaining.

Can anyone tell me what I'm missing? Tks, Kelli

Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select

For Each rngCurrentCell In Worksheets("Floor").Range("H:H").Cells
If rngCurrentCell.Value < 0.01 Then
rngCurrentCell.EntireRow.Delete
End If
Next
 
As Ron pointed out if you want to delete you need to move from the bottom up,
or you can just collect all of the cells that you find into one big range
object and delete them all in one big delete. Depending on how many rows you
have to delete this can be quite a bit faster...

Sub test()
Dim rngCurrentCell As Range
Dim rngFoundAll As Range

For Each rngCurrentCell In Worksheets("Floor").Range("H:H").Cells
If rngCurrentCell.Value < 0.01 Then
If rngFoundAll Is Nothing Then
Set rngFoundAll = rngCurrentCell
Else
Set rngFoundAll = Union(rngCurrentCell, rngFoundAll)
End If

End If
Next
If Not rngFoundAll Is Nothing Then rngFoundAll.EntireRow.Delete

End Sub
 
Hi KelliInCali and Jim

I like to add this to Jim's reply:

You can find a Union example on my site also
See that I do a test for a error in the loop.
Jim's code blow if you have a error in column H
 
Thanks Ron... Somehow today is not my day... My code will crash if no cells
are found to delete... Thanks for catching that... Speaking of blow, my
transmission blew today. Regretably my day has not improved since then. I
think I might just go back to bed now before I do any more damage...
 
I was wondering. I don't normally see you here at this time but Tom is there
24/7 so nothing surprises me anymore... By the way where is Tom??? It is
kinda lonely here without him...
 
Jim and Ron,
Thank you both very much. I got the Union to work and all is perf!! Norman
(if you know him) had also given me a Union loop for another problem, but I
couldn't adapt it to work.. your suggestions helped immensely!
Thanks again... get some sleep Jim!
Kelli
 
Hi Jim,

Do you mind if I ask another question? I have to add addtional conditions
to the entire row delete you helped me with, but from another row. This is
what I have, and my question is below it:

'Deletes entire row in "Floor" for records when H is blank or < 0
Dim ViewMode As Long
Dim rngCurrentCell As Range
Dim rowDel As Range

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView


Sheets("Floor").Select
Range("A2").Select

With ActiveSheet
.DisplayPageBreaks = False

Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select


For Each rngCurrentCell In Worksheets("Floor").Range("H:H").Cells
If IsEmpty(rngCurrentCell) Or rngCurrentCell.Value < 0.01 Or
rngCurrentCell.Value = "" Then
If rowDel Is Nothing Then
Set rowDel = rngCurrentCell
Else
Set rowDel = Application.Union(rowDel, rngCurrentCell)
End If
End If

Next
End With

If Not rowDel Is Nothing Then
rowDel.EntireRow.Delete
End If

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With


So... what I want to do is add a condition so that the row is deleted only
if the value in BOTH H AND K is empty, a space, or less than .01. Can I just
duplicate the For/Next Union collection for setting rowDel, changing the cols
to K:K, or will that not work? Can I specify more than one column range in
the same For/Next?
-kelli
 
You can use Offset in the loop to test the cells in other columns or use it like this

ElseIf .Cells(Lrow, "A").Value = "ron" And _
.Cells(Lrow, "B").Value = "dave" And _
.Cells(Lrow, "C").Value > 10 Then .Rows(Lrow).Delete
 
Ok... Do I have it correct below? I tried it and now it's deleting ALL rows
even if there is a value in H or K.


With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = .Cells(.Rows.Count, "B").End(xlUp).Row

For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, "H").Value) Then
ElseIf .Cells(Lrow, "H").Value < 0.01 Or _
.Cells(Lrow, "H").Value = "" And _
.Cells(Lrow, "K").Value < 0.01 Or _
.Cells(Lrow, "K").Value = "" Then
.Rows(Lrow).Delete
End If

Next
End With
 
Aha... I figured it out... replaced the "And" with another "If" and it works!
Thanks very much! -kelli

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView


Sheets("Floor").Select
Range("A2").Select

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = .Cells(.Rows.Count, "B").End(xlUp).Row

For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, "H").Value) Then
ElseIf .Cells(Lrow, "H").Value < 0.01 Or _
.Cells(Lrow, "H").Value = "" Then
If .Cells(Lrow, "K").Value < 0.01 Or _
.Cells(Lrow, "K").Value = "" Then
.Rows(Lrow).Delete
End If
End If

Next
End With
 
Back
Top