Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
find text delete row
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 Rob |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
find text delete row
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
find text delete row
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
find text delete row
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
find text delete row
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 |
#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 |
Reply |
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 |