find text delete row

O

okrob

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
 
R

Ron de Bruin

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 said:
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
Click to expand...
 
O

okrob

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
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 said:
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
Click to expand...
Click to expand...
 
R

Ron de Bruin

Oops sorry

Try this

Criteria1:="*" & myArr(I) & "*"


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


okrob said:
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
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 said:
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
Click to expand...
Click to expand...
Click to expand...
 
O

okrob

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 said:
Oops sorry

Try this

Criteria1:="*" & myArr(I) & "*"


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


okrob said:
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
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


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
Click to expand...
Click to expand...
Click to expand...
 
R

Ron de Bruin

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 said:
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 said:
Oops sorry

Try this

Criteria1:="*" & myArr(I) & "*"


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


okrob said:
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


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
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Combine three InputBoxes into one? 7
Copy Entire Row - Rick Rothstein ? 2
Find Cells with Specific Format 1
Worksheet level names 5
Reg:Macro needed to pick up only distinct values but it picks up allthe values 4
Average Value Revisited 11
Using Find & FindNext in a form 3
Can this be condensed 4

Top