delete code keeps going and coing
 

Hello I copied this code in the from one of the Answers in the Comunity
to "This workbook" I adjusted to read column J but when I run the code
it keeps going and going . it does not stop. I need this to look in cloumn
J3 to J7000 thanks
Option Explicit
Sub testme02()

Dim myRng As Range
Dim FoundCell As Range
Dim wks As Worksheet
Dim myStrings As Variant
Dim iCtr As Long

myStrings = Array("ISA") 'add more strings if you need

Set wks = ActiveSheet

With wks
Set myRng = .Range("a6:a" & .Rows.Count)
End With

For iCtr = LBound(myStrings) To UBound(myStrings)
Do
With myRng
Set FoundCell = .Cells.Find(what:=myStrings(iCtr), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
End With
Loop
Next iCtr
End Sub

delete code keeps going and coing
 

You are deleting every blnak row in the workbook up to row 65,536. Try this
change


from

With wks
Set myRng = .Range("a6:a" & .Rows.Count)
End With

to

With wks
LastRow = .Range("A" & rows.count).end(xlup).row
Set myRng = .Range("a6:a" & LastRow)
End With


"Wanna Learn" wrote:

Hello I copied this code in the from one of the Answers in the Comunity
to "This workbook" I adjusted to read column J but when I run the code
it keeps going and going . it does not stop. I need this to look in cloumn
J3 to J7000 thanks
Option Explicit
Sub testme02()

Dim myRng As Range
Dim FoundCell As Range
Dim wks As Worksheet
Dim myStrings As Variant
Dim iCtr As Long

myStrings = Array("ISA") 'add more strings if you need

Set wks = ActiveSheet

With wks
Set myRng = .Range("a6:a" & .Rows.Count)
End With

For iCtr = LBound(myStrings) To UBound(myStrings)
Do
With myRng
Set FoundCell = .Cells.Find(what:=myStrings(iCtr), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
End With
Loop
Next iCtr
End Sub

delete code keeps going and coing
 

That code works fine on my system... I have cleaned it a up a bit here but
there is nothing specificaly wrong with what you had... Define won't stop
running. Have you stepped through the code to see what is going on? Is it
deleteing? Is it finding anything? Do you have calculations other event code
being triggered by the change?

Sub testme02()

Dim myRng As Range
Dim FoundCell As Range
Dim myStrings As Variant
Dim iCtr As Long

myStrings = Array("ISA") 'add more strings if you need


Set myRng = ActiveSheet.Range("a6:a" & Rows.Count)

For iCtr = LBound(myStrings) To UBound(myStrings)
Do
With myRng
Set FoundCell = .Cells.Find(what:=myStrings(iCtr), _
LookIn:=xlValues, _
lookat:=xlWhole, _
MatchCase:=False)

If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
End With
Loop
Next iCtr
End Sub
--
HTH...

Jim Thomlinson


"Wanna Learn" wrote:

Hello I copied this code in the from one of the Answers in the Comunity
to "This workbook" I adjusted to read column J but when I run the code
it keeps going and going . it does not stop. I need this to look in cloumn
J3 to J7000 thanks
Option Explicit
Sub testme02()

Dim myRng As Range
Dim FoundCell As Range
Dim wks As Worksheet
Dim myStrings As Variant
Dim iCtr As Long

myStrings = Array("ISA") 'add more strings if you need

Set wks = ActiveSheet

With wks
Set myRng = .Range("a6:a" & .Rows.Count)
End With

For iCtr = LBound(myStrings) To UBound(myStrings)
Do
With myRng
Set FoundCell = .Cells.Find(what:=myStrings(iCtr), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
End With
Loop
Next iCtr
End Sub

delete code keeps going and coing
 

Thank YOu
I code sems to go through the entire workbook, ( I have 29 worksheets) .the
code should only apply to the active sheet. I ran the code it took about 6
minutes
I save the code the "This workbook". thanks again
"Jim Thomlinson" wrote:

That code works fine on my system... I have cleaned it a up a bit here but
there is nothing specificaly wrong with what you had... Define won't stop
running. Have you stepped through the code to see what is going on? Is it
deleteing? Is it finding anything? Do you have calculations other event code
being triggered by the change?

Sub testme02()

Dim myRng As Range
Dim FoundCell As Range
Dim myStrings As Variant
Dim iCtr As Long

myStrings = Array("ISA") 'add more strings if you need


Set myRng = ActiveSheet.Range("a6:a" & Rows.Count)

For iCtr = LBound(myStrings) To UBound(myStrings)
Do
With myRng
Set FoundCell = .Cells.Find(what:=myStrings(iCtr), _
LookIn:=xlValues, _
lookat:=xlWhole, _
MatchCase:=False)

If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
End With
Loop
Next iCtr
End Sub
--
HTH...

Jim Thomlinson


"Wanna Learn" wrote:

Hello I copied this code in the from one of the Answers in the Comunity
to "This workbook" I adjusted to read column J but when I run the code
it keeps going and going . it does not stop. I need this to look in cloumn
J3 to J7000 thanks
Option Explicit
Sub testme02()

Dim myRng As Range
Dim FoundCell As Range
Dim wks As Worksheet
Dim myStrings As Variant
Dim iCtr As Long

myStrings = Array("ISA") 'add more strings if you need

Set wks = ActiveSheet

With wks
Set myRng = .Range("a6:a" & .Rows.Count)
End With

For iCtr = LBound(myStrings) To UBound(myStrings)
Do
With myRng
Set FoundCell = .Cells.Find(what:=myStrings(iCtr), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
End With
Loop
Next iCtr
End Sub

delete code keeps going and coing
 

First, the code doesn't belong in the ThisWorkbook module. It belongs in a
plain old general module.

But if you have events enabled and calculation set to automatic, then each time
you delete a row, the event could fire--and excel could recalc.

And I've never seen it bother excel too much if I look through the entire column
or just a range -- as long as it doesn't matter to me. (I did change the column
to J.)

Option Explicit
Sub testme02()

Dim myRng As Range
Dim FoundCell As Range
Dim wks As Worksheet
Dim myStrings As Variant
Dim iCtr As Long

Dim CalcMode As Long
Dim ViewMode As Long

myStrings = Array("ISA") 'add more strings if you need

Set wks = ActiveSheet

Application.ScreenUpdating = False

CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

ActiveSheet.DisplayPageBreaks = False

With wks
Set myRng = .Range("j6:j" & .Rows.Count)
End With

For iCtr = LBound(myStrings) To UBound(myStrings)
Do
With myRng
Set FoundCell = .Cells.Find(what:=myStrings(iCtr), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
End With
Loop
Next iCtr

'put things back to what they were
Application.Calculation = CalcMode
ActiveWindow.View = ViewMode

End Sub

And if you still think that the routine is cycling through all the worksheets in
the workbook, then do a manual edit|Find and make sure that the "within" box
says Sheet (click the options button if you don't see that box!).





Wanna Learn wrote:

Hello I copied this code in the from one of the Answers in the Comunity
to "This workbook" I adjusted to read column J but when I run the code
it keeps going and going . it does not stop. I need this to look in cloumn
J3 to J7000 thanks
Option Explicit
Sub testme02()

Dim myRng As Range
Dim FoundCell As Range
Dim wks As Worksheet
Dim myStrings As Variant
Dim iCtr As Long

myStrings = Array("ISA") 'add more strings if you need

Set wks = ActiveSheet

With wks
Set myRng = .Range("a6:a" & .Rows.Count)
End With

For iCtr = LBound(myStrings) To UBound(myStrings)
Do
With myRng
Set FoundCell = .Cells.Find(what:=myStrings(iCtr), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
End With
Loop
Next iCtr
End Sub

--

Dave Peterson

delete code keeps going and coing
 

Ps. Change J6 to J3

or use:

With wks
Set myRng = .Range("J:J")
End With

Wanna Learn wrote:

Hello I copied this code in the from one of the Answers in the Comunity
to "This workbook" I adjusted to read column J but when I run the code
it keeps going and going . it does not stop. I need this to look in cloumn
J3 to J7000 thanks
Option Explicit
Sub testme02()

Dim myRng As Range
Dim FoundCell As Range
Dim wks As Worksheet
Dim myStrings As Variant
Dim iCtr As Long

myStrings = Array("ISA") 'add more strings if you need

Set wks = ActiveSheet

With wks
Set myRng = .Range("a6:a" & .Rows.Count)
End With

For iCtr = LBound(myStrings) To UBound(myStrings)
Do
With myRng
Set FoundCell = .Cells.Find(what:=myStrings(iCtr), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
Exit Do
Else
FoundCell.EntireRow.Delete
End If
End With
Loop
Next iCtr
End Sub

--

Dave Peterson