quicker way to execute?

J

J.W. Aldridge

This code works...(Thanx DP!) But locks everything up for about 5
minutes or more before it actually finishes executing.

Any suggestions?

(Note: I run the same code twice, the first time, it runs in about 2
minutes. The second time - later in the code, is when it locks
everything up).


Sub DeleteRows2()

Dim LastRow As Long
Dim rw As Long
Dim DeptCode As String

DeptCode = InputBox(Prompt:="Please type in your department code
(only one): PCPA, PCPB, OFIA, OFIB, FHI", _
Title:="Department Filter")

'If Len(Trim(DeptCode)) <> 4 Then
'MsgBox "Canceling your report...Thanx!"
'Exit Sub
'End If

Application.ScreenUpdating = False
With ActiveSheet 'I like to qualify my ranges
LastRow = .Cells(.Rows.Count, "f").End(xlUp).Row
For rw = LastRow To 2 Step -1
If LCase(.Cells(rw, "f").Value) <> LCase(DeptCode) Then
.Rows(rw).Delete
End If
Next rw
End With
Application.ScreenUpdating = True

End Sub
 
J

joeu2004

This code works...(Thanx DP!) But locks everything up for about 5
minutes or more before it actually finishes executing.
Any suggestions?

Add Application.Calculation = xlCalculationManual after
Application.ScreenUpdating=False, and Application.Calculation =
xlCalculationAutomatic before Application.ScreenUpdating=True.

Actually, it woud be more robust to save and restore the initial state
of Application.Calculation.
 
J

joeu2004

This code works...(Thanx DP!) But locks everything up for about 5
minutes or more before it actually finishes executing.
Any suggestions?

Compute LCase(DeptCode) outside the loop. Probably not a significant
source of performance degradation, but generally a good programming
practice.
 
D

Dave Peterson

Do you see the dotted lines that you get after you do a print or print preview?

If you do
Tools|Options|view tab|uncheck display page breaks

does the run time go back to normal?

You may want to do something like:

Option Explicit
Sub testme()

Dim CalcMode As Long
Dim ViewMode As Long

Application.ScreenUpdating = False

CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

ActiveSheet.DisplayPageBreaks = False

'do the work (Your code goes here)


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

End Sub

Being in View|PageBreak Preview mode can slow macros down, too.

=========
If you run these procedures on their own, you may want to put that stuff in each
procedure--and remove it from the giant (do all of them at once).

==========================
Looping through the rows and deleting them can be very slow.

You could change the code to create a range of cells that should be deleted,
then delete that range at the end.

=======
Option Explicit
Sub DeleteRows2A()

Dim CalcMode As Long
Dim ViewMode As Long
Dim myList As Variant
Dim myListAsStr As String
Dim res As Variant 'could be an error

Dim LastRow As Long
Dim rw As Long
Dim DeptCode As String

myList = Array("PCPA", "PCPB", "OFIA", "OFIB", "FHI")
'Join was added in xl2k.
'It won't work in earlier versions -- or on Mac's.
myListAsStr = Join(myList, ", ")

DeptCode = InputBox(Prompt:="Please type in your department code" _
& " (only one):" & vbLf & myListAsStr, _
Title:="Department Filter")

If Trim(DeptCode) = "" Then
'user hit cancel
Exit Sub
End If

res = Application.Match(DeptCode, myList, 0)

If IsError(res) Then
MsgBox "Please select from the list!"
Exit Sub
End If

Application.ScreenUpdating = False

CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

ActiveSheet.DisplayPageBreaks = False

With ActiveSheet 'I like to qualify my ranges
LastRow = .Cells(.Rows.Count, "f").End(xlUp).Row
For rw = LastRow To 2 Step -1
If LCase(.Cells(rw, "f").Value) <> LCase(DeptCode) Then
.Rows(rw).Delete
End If
Next rw
End With

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

End Sub

============
This version builds the range and deletes it at the end. Excel does have a bug
that if this range has more than 8192 discontinuous areas, it'll break -- with
no notice. So you'll want to know your data before settling on this one:

Option Explicit
Sub DeleteRows2B()

Dim CalcMode As Long
Dim ViewMode As Long
Dim myList As Variant
Dim myListAsStr As String
Dim res As Variant 'could be an error

Dim LastRow As Long
Dim rw As Long
Dim DeptCode As String
Dim DelRng As Range

myList = Array("PCPA", "PCPB", "OFIA", "OFIB", "FHI")
'Join was added in xl2k.
'It won't work in earlier versions -- or on Mac's.
myListAsStr = Join(myList, ", ")

DeptCode = InputBox(Prompt:="Please type in your department code" _
& " (only one):" & vbLf & myListAsStr, _
Title:="Department Filter")

If Trim(DeptCode) = "" Then
'user hit cancel
Exit Sub
End If

res = Application.Match(DeptCode, myList, 0)

If IsError(res) Then
MsgBox "Please select from the list!"
Exit Sub
End If

Application.ScreenUpdating = False

CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

ActiveSheet.DisplayPageBreaks = False

With ActiveSheet 'I like to qualify my ranges
LastRow = .Cells(.Rows.Count, "f").End(xlUp).Row
For rw = LastRow To 2 Step -1
If LCase(.Cells(rw, "f").Value) <> LCase(DeptCode) Then
If DelRng Is Nothing Then
Set DelRng = .Cells(rw, "A")
Else
Set DelRng = Union(.Cells(rw, "A"), DelRng)
End If
End If
Next rw
End With

'do the delete in one step
If DelRng Is Nothing Then
'do nothing
Else
DelRng.EntireRow.Delete
End If

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

End Sub
 
P

Pete_UK

If it takes 5 minutes then you must have a lot of data. A faster
algorithm would be to sort your data on column F, and then you will
have contiguous blocks of FHI, OFIA, OFIB, PCPA and PCPB. It is then
much easier to identify which blocks should be deleted - you could
apply a filter for not equal to Deptcode and then delete the visible
records.

If the original sort order is important to you then you should fill a
simple seqence (1, 2, 3 etc) down a helper column and include that
helper column in your sort range. After you have deleted the unwanted
blocks of data you can sort back into the original order using the
sequence as the sort field, and then you can delete the helper column.
This should speed up your macro considerably.

Hope this helps.

Pete
 

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

Top