Excel VBA Code Execution Excel XP Vs Excel Office 2000

[John Flynn]

An application I have written runs in seconds in Excel
2000 but takes minutes using Excel 2002 the offending code
is the ActiveCell.EntireRow.Delete statement in the code
subset listed below. One by one rows are deleted taking
lots of time (XP) -- same code same everything Office
2000 - instantly. Any ideas are welcome.

Thanks

Do
If ActiveCell.Value = "Delete" Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell.Value = "" Or ActiveCell.Row > 1000

 

[keepitcool]

circumventing excel quirks

this may have to do with a "bug?" in show pagebreaks.


step 1.
try it with
application.screenupdating=false

step2.
try deleting lines from bottom row going up.

suc6



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[Myrna Larson]

Do you have screen updating off, calculation set to manual, and events turned off while the code
runs? All of those will speed things up.

In addition, you can speed up your loop by not selecting anything and doing only a single
deletion -- see code below.

But there are other, faster ways to do this. I assume since you quit when encountering a blank
cell, that there are no embedded blanks in this column.

If that's correct and your data starts in column A, you can convert the cells that contain
"Delete" to blanks with one command, select the blank cells with a 2nd command and delete the
rows with a 3rd:

Sub DeleteRows()
Dim Rng As Range

'set a variable to point to column the active cell is in
Set Rng = ActiveSheet.UsedRange.Columns(ActiveCell.Column)

'clear cells containing 'Delete' #1
Rng.Replace What:="Delete", Replacement:="", LookAt:=xlWhole, MatchCase:=False

'select those newly blank cells #2
On Error Resume Next
Set Rng = Rng.SpecialCells(xlCellTypeBlanks)

If Err.Number = 0 Then 'i.e. we found some blank cells
Rng.EntireRow.Delete '#3
End If
End Sub

But you should really surround the Delete statement with the same "With Application" blocks that
you see in the next sub.

Here's code to use a loop:

Sub DeleteRows()
Dim DelRange As Range
Dim i As Long

i = 0
Do
With ActiveCell.Offset(i, 0)
If .Row = 1000 Or .Value = "" Then Exit Do

If .Value = "Delete" Then
If DelRange is Nothing Then
Set DelRange = .Cells(1)
Else
Set DelRange = Union(DelRange, .Cells(1))
End If
End If
End With
i = i + 1
Loop

If (DelRange Is Nothing) = False Then
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

DelRange.EntireRow.Delete

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End If

End Sub

 

[Myrna Larson]

What bug are you referring to? The Subscript Out of Range problem, or something new?

 

[keepitcool]

Myrna..

"bug" may have been the wrong word,
but quirk sums it up nicely..
results for xl97 and xlXP are same.


Following may illustrate the effect
pagebreak visibility



Option Explicit

Sub PBeffect()
Dim dStart#, dElapsed#(0 To 1)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

ActiveSheet.DisplayAutomaticPageBreaks = True
dStart = Timer
Test
dElapsed(0) = Timer - dStart

ActiveSheet.DisplayAutomaticPageBreaks = False
dStart = Timer
Test
dElapsed(1) = Timer - dStart

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

MsgBox dElapsed(0) & vbNewLine & dElapsed(1)
End Sub

Private Sub Test()
Dim i%
With ActiveSheet
.UsedRange.Clear
.[a1:a1000].Value = "1"
i = .UsedRange.Count
For i = 1 To .UsedRange.Rows.Count
.Rows(1).Delete
Next
End With
End Sub




keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[Dave Peterson]

And one more thing to add to the top of your code:

ActiveSheet.DisplayPageBreaks = False

(maybe you weren't showing pagebreak lines in xl2k. When you have those little
dotted lines showing, then each time you delete a row, excel wants to update
that position. Turn off the pagebreaks and excel won't care (until later).)

You can try it by turning them off manually:
Tools|Options|view Tab|Uncheck PageBreaks

(in fact, try it both ways to see if you agree)

 

[turbopsy1]

I don't know if this will help or not but...worth a try.

Set the "Application.ScreenUpdating = False" just prior to your Do-Loop
event and "Application.ScreenUpdating = True" after the looping event is
finished. Good Luck.

John