Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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
Thanks in advance,
Rob

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,123
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 142
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,123
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 142
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,123
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
find & delete rows based on text deb Excel Discussion (Misc queries) 4 September 17th 08 01:02 AM
How to find & delete a particular pattern of text from values of a Mansa Excel Discussion (Misc queries) 10 June 3rd 08 08:26 AM
find text and delete rows. John Excel Discussion (Misc queries) 5 December 12th 07 04:25 AM
find cell that contains text and delete entre row Cristi R Excel Discussion (Misc queries) 3 August 2nd 06 04:32 PM
find and delete text, find a 10-digit number and put it in a textbox Paul Excel Programming 3 November 16th 04 04:21 PM


All times are GMT +1. The time now is 05:13 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"