How to Delete rows based on multiple criteria

Posted by Brad on November 29, 2000 5:51 AM

Hello, I am using the following code to delete all rows that don't contain a number (in this case 87012). How would I do this to keep more than one number? i.e. 87012 and 84759 and 28245. Here is the code so far

Dim theRange As Range
Dim lastRow&, firstRow&, x&
Set theRange = ActiveSheet.UsedRange
lastRow = theRange.Cells(theRange.Cells.Count).Row
firstRow = theRange.Cells(1).Row
For x = lastRow To firstRow Step -1
If Not Cells(x, 5) = "87012" Then
Rows(x).Delete
End If
Next

Thanks,
Brad

Posted by Celia on November 29, 2000 6:29 AM

Brad

If Not Cells(x, 5) = 87012 And Not Cells(x, 5) = 84759 And Not Cells(x, 5) = 28245 Then

Celia

Posted by Brad on November 29, 2000 1:21 PM

Thanks Celia. It did work. But my sheet is like 3500+ Rows and this takes a very long time. Is there a quicker way to do this? My computer locks up for like 3-5 minutes doing this calculation.
Thanks
Brad

Posted by Ben O. on November 29, 2000 3:03 PM

Try applying the autofilter and filtering out all of the rows that you don't want deleted. Then you can delete your entire range of data, minus the column headers, with Selection.ClearContents. When you remove the autofilter, only the data that you want remains. You can then sort the data so the blank rows are moved to the bottom. It is relatively easy to automate this process in a macro. I think I gave an example to someone else in this forum, but I can't find the message now.

Good luck,

-Ben

Posted by Ben O. on November 29, 2000 3:09 PM

Here's the code....

I found it:

Range("therange").AutoFilter Field:=14, Criteria1:="Criteria1:="&LT;=0"
Range("A2:M2000").ClearContents
Worksheets("Sheet1").AutoFilterMode = Off

You'll have the change the autofilter critera to your own, and change the range that is cleared to your range, minus the header row.

-Ben O.

Posted by Celia on November 29, 2000 4:15 PM

Brad
Here's an alternative to Ben's method which should be a lot quicker than the original macro that was posted :-

Dim theRange As Range, col As Range
Dim cell As Range, toDel As Range, x%
Set col = Columns(5)
Set theRange = Intersect(ActiveSheet.UsedRange, col)
For Each cell In theRange
If cell &LT;&GT; 87012 And cell &LT;&GT; 84759 And cell &LT;&GT; 28245 Then
If x = 0 Then
Set toDel = cell
x = 1
Else
Set toDel = Union(toDel, cell)
End If
End If
Next
toDel.EntireRow.Delete

Posted by Brad on November 30, 2000 8:17 AM

Celia, I got a Run-Time error "13"
Type Mismatch
on the "If cell &LT;&GT;" line
suggestions?

Brad

Posted by Celia on November 30, 2000 2:54 PM

Brad
Can't think why you are getting a Type Mismatch error.
In the offending line, try putting the numbers in quotes and/or adding .Value after cell.
If it still doesn't work, send your workbook so I can take a look.
Celia