| Home |
| Search |
| Today's Posts |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
find text delete row
I used the following and it worked perfectly... Thanks!
A user that read my webpage <g I love both (filter and find) but most of the time I loop because you have more control -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "okrob" wrote in message ups.com... 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 |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| find & delete rows based on text | Excel Discussion (Misc queries) | |||
| How to find & delete a particular pattern of text from values of a | Excel Discussion (Misc queries) | |||
| find text and delete rows. | Excel Discussion (Misc queries) | |||
| find cell that contains text and delete entre row | Excel Discussion (Misc queries) | |||
| find and delete text, find a 10-digit number and put it in a textbox | Excel Programming | |||
Threaded Mode
