I used the following and it worked perfectly... Thanks!
Rob
Sub FindExample1()
Dim myArr As Variant
Dim Rng As Range
Dim I As Long
Application.ScreenUpdating = False
myArr = Array("1", "3", "5")
' Changed 1, 3, and 5 to what I'm looking for...
For I = LBound(myArr) To UBound(myArr)
Do
Set Rng = Range("A:A").Find(What:=myArr(I), _
After:=Range("A" & Rows.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
' Changed this to Part since I just want part of the cell...
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'If you want to search in a part of the rng.value then use
xlPart
'if you use LookIn:=xlValues it will also delete rows with
a
'a formula that evaluates to "ron"
If Not Rng Is Nothing Then Rng.EntireRow.Delete
Loop While Not (Rng Is Nothing)
Next I
Application.ScreenUpdating = True
End Sub
================================================== =
Ron de Bruin wrote:
Oops sorry
Try this
Criteria1:="*" & myArr(I) & "*"
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"okrob" wrote in message oups.com...
It doesn't seem to work since I'm only looking at part of the cell, not
the entire contents. I'll work on it, this may yet become the
solution.
Thanks,
Rob
Ron de Bruin wrote:
You can use the Autofilter example from this page maybe
http://www.rondebruin.nl/delete.htm
Sub Delete_with_Autofilter_Array()
Dim Rng As Range
Dim I As Long
Dim myArr As Variant
myArr = Array("ron", "Dave", "Jelle")
For I = LBound(myArr) To UBound(myArr)
ActiveSheet.Range("A1:A100").AutoFilter Field:=1, Criteria1:=myArr(I)
With ActiveSheet.AutoFilter.Range
Set rng = Nothing
On Error Resume Next
Set Rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not Rng Is Nothing Then Rng.EntireRow.Delete
End With
Next I
ActiveSheet.AutoFilterMode = False
End Sub
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"okrob" wrote in message ps.com...
Need some help condensing this code...
I used some of that good old copy and paste from this group to make
these, but I wondered if I could condense them into one loop so that
I'm not looping the entire column 3 times. It gets large and takes a
long time.
I call the subs from another routine and afterward I turn on the screen
updating.
Basically the code searches the column from the bottom to the top
looking for 3 different things and when it finds it, it deletes the
entire row.
Code:
Sub killRow1()
Application.ScreenUpdating = False
On Error Resume Next
Dim rRow()
nrows = ActiveSheet.UsedRange.Rows.Count
ReDim rRow(nrows)
Application.Calculation = xlCalculationManual
With ActiveSheet.Range("A1:A" & nrows)
Set C = .Find(What:="8=FWD", LookIn:=xlFormulas, Lookat:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
Do
Number = Number + 1
rRow(Number) = C.Row
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address < firstAddress
End If
End With
For i = Number To 1 Step -1
Range("A" & rRow(i)).EntireRow.Delete
Next i
'MsgBox "8=FWD done"
Application.Calculation = xlCalculationAutomatic
End Sub
Sub killRow2()
Application.ScreenUpdating = False
On Error Resume Next
Dim rRow()
nrows = ActiveSheet.UsedRange.Rows.Count
ReDim rRow(nrows)
Application.Calculation = xlCalculationManual
With ActiveSheet.Range("A1:A" & nrows)
Set C = .Find(What:="PF KEY", LookIn:=xlFormulas, Lookat:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
Do
Number = Number + 1
rRow(Number) = C.Row
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address < firstAddress
End If
End With
For i = Number To 1 Step -1
Range("A" & rRow(i)).EntireRow.Delete
Next i
'MsgBox "PF KEY done"
Application.Calculation = xlCalculationAutomatic
End Sub
Sub killRow3()
Application.ScreenUpdating = False
On Error Resume Next
Dim rRow()
nrows = ActiveSheet.UsedRange.Rows.Count
ReDim rRow(nrows)
Application.Calculation = xlCalculationManual
With ActiveSheet.Range("A1:A" & nrows)
Set C = .Find(What:="END OF DATA", LookIn:=xlFormulas,
Lookat:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
Do
Number = Number + 1
rRow(Number) = C.Row
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address < firstAddress
End If
End With
For i = Number To 1 Step -1
Range("A" & rRow(i)).EntireRow.Delete
Next i
'MsgBox "END OF DATA done"
Application.Calculation = xlCalculationAutomatic
End Sub
Thanks in advance,
Rob