Why does this loop only NEARLY work?!

[Andrew]

Hi all

I have the following code. The theory is that the code loops through a
range supplied by name, and looks for matches in a set of data.

The code almost works! But not quite.

Many rows are removed, but some remain. However, running the procedure
a second time results in all the remaining matches being removed.

Anyone any ideas? Incidentally, I've been testing it on an export of
the Orders table from Northwind, with a second sheet holding 3 or 4
countries for which I want to remove data.

Thanks very much,

Andrew

Sub RemoveSpecifiedRows()
Dim strCriteriaRange As String, strCol As String
Dim rngCriteria As Range
Dim rngCell1 As Range
Dim rngCell2 As Range
Dim intCounter As Integer

strCriteriaRange = InputBox("Enter name of range containing the
criteria values")
strCol = InputBox("Enter the column letter to search")
Set rngCriteria = Range(strCriteriaRange)
Application.ScreenUpdating = False

For Each rngCell1 In rngCriteria.Cells
For Each rngCell2 In ActiveSheet.Columns(strCol).Cells
If rngCell2.Value = rngCell1.Value Then
rngCell2.EntireRow.Delete shift:=xlShiftUp
intCounter = intCounter + 1
End If
Next rngCell2
Next rngCell1

Application.ScreenUpdating = True
MsgBox intCounter & " rows were successfully deleted"

End Sub

 

[Jim Thomlinson]

Deleting rows in a For Each is inherantly flawed as the range being traversed
is changing at run time. You want to do the delete outside of the for each.
Additionally This code will be faster as deleting is a relatively slow
process...

Sub RemoveSpecifiedRows()
Dim strCriteriaRange As String, strCol As String
Dim rngCriteria As Range
Dim rngCell1 As Range
Dim rngCell2 As Range
Dim rngToDelete as Range
Dim intCounter As Integer

strCriteriaRange = InputBox("Enter name of range containing the
criteria values")
strCol = InputBox("Enter the column letter to search")
Set rngCriteria = Range(strCriteriaRange)
Application.ScreenUpdating = False

For Each rngCell1 In rngCriteria.Cells
For Each rngCell2 In ActiveSheet.Columns(strCol).Cells
If rngCell2.Value = rngCell1.Value Then
if rngtodelete is nothing then
set rngTodelete = rngCell2
Else
set rngToDelete = Union(rngCell2, rngToDelete)
End If
intCounter = intCounter + 1
End If
Next rngCell2
Next rngCell1
if not rngToDelete is nothing then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
MsgBox intCounter & " rows were successfully deleted"

End Sub

 

[INTP56]

Here's some code I posted several pages back. It's not exactly what you want,
but you could probably make it work with variants, and add in how many
deletes occured. Also, I would trap or optionally specify if it should delete
"blank" rows.

Option Explicit

Public Sub DeleteRows2(rngSearch As Range, strSearch As String)
Dim rngHitCell As Range
Set rngHitCell = rngSearch.Find _
(What:=strSearch _
, LookIn:=xlFormulas _
, LookAt:=xlWhole _
, SearchOrder:=xlByRows _
, SearchDirection:=xlNext _
, MatchCase:=False _
, SearchFormat:=False _
)

While Not rngHitCell Is Nothing
rngSearch.Parent.Rows(rngHitCell.Row).Delete
Set rngHitCell = rngSearch.FindNext
Wend
End Sub

Sub RemoveSpecifiedRows2()
Dim strCriteriaRange As String
Dim rngCriteria As Range
Dim rngCell1 As Range
Dim intSearchColumn As Integer
Dim intCounter As Integer

strCriteriaRange = InputBox("Enter name of range containing the criteria
values")
intSearchColumn = InputBox("Enter the column number to search")
Set rngCriteria = Range(strCriteriaRange)
Application.ScreenUpdating = False

For Each rngCell1 In rngCriteria.Cells
DeleteRows2 Columns _
rngSearch := Columns(intSearchColumn) _
, strSearch := cstr(rngCell1.value)
Next rngCell1

Application.ScreenUpdating = True
End Sub

Bob

 

[Andrew]

Deleting rows in a For Each is inherantly flawed as the range being traversed
is changing at run time. You want to do the delete outside of the for each.
Additionally This code will be faster as deleting is a relatively slow
process...

Sub RemoveSpecifiedRows()
Dim strCriteriaRange As String, strCol As String
Dim rngCriteria As Range
Dim rngCell1 As Range
Dim rngCell2 As Range
Dim rngToDelete as Range
Dim intCounter As Integer

strCriteriaRange = InputBox("Enter name of range containing the
criteria values")
strCol = InputBox("Enter the column letter to search")
Set rngCriteria = Range(strCriteriaRange)
Application.ScreenUpdating = False

For Each rngCell1 In rngCriteria.Cells
For Each rngCell2 In ActiveSheet.Columns(strCol).Cells
If rngCell2.Value = rngCell1.Value Then
if rngtodelete is nothing then
set rngTodelete = rngCell2
Else
set rngToDelete = Union(rngCell2, rngToDelete)
End If
intCounter = intCounter + 1
End If
Next rngCell2
Next rngCell1
if not rngToDelete is nothing then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
MsgBox intCounter & " rows were successfully deleted"

End Sub
--
HTH...

Jim Thomlinson














- Show quoted text -

Perfect. Thanks very much for your help and the information.

Best regards
Andrew Richards