On Jul 25, 5:32 pm, Jim Thomlinson <James_Thomlin...@owfg-Re-Move-
This-.com wrote:
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



"Andrew" wrote:
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- Hide quoted text -

- Show quoted text -

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

Best regards
Andrew Richards