How can my macro run faster ?


R

Roger

I have a set of 5 macros which analyse and finally format data. It starts
with about 5000 records and ends up with around 250. I have one "super"
macro which calls and runs each of the other macros in turn, ie

Application.CutCopyMode = False
Application.Run "Agenda.xls!SortDossierOrder"
Application.Run "Agenda.xls!DeleteDuplicates"
Application.Run "Agenda.xls!DeleteExtraRows"
Application.Run "Agenda.xls!DeleteRecentRecords"
Application.Run "Agenda.xls!DeleteExtraCols"
End Sub

Would it be faster to copy and paste each of these macros into one single
macro ? Is there any way I can suppress the screen during the macro running
to save processing time and make it run faster ... it has to sort through
each of the records 4 times and you can see it on the screen working ? I am
using Excel 2002 sp3 on XP

Thanks .. Roger
 
Ad

Advertisements

D

Dave Peterson

If the macro that calls these 5 routines is also in the Agenda.xls workbook, I'd
use:

Application.CutCopyMode = False
application.screenupdating = false '<-- to hide the flickering

Call SortDossierOrder
call DeleteDuplicates
Call DeleteExtraRows
Call DeleteRecentRecords
call DeleteExtraCols

application.screenupdating = True '<-- set it back to normal

End Sub
 
D

Don Guillett

You may also be using selections which are not necessary and slow things
down. Some of your macros may??? be able to be combined but I would have to
see .
If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.
 
J

JP

In addition to what Dave suggested, posting your code would allow others to
make improvement suggestions.

--JP
 
R

Roger

Thanks for reply, the five macros are run with the "super" macro below.
Individually they are as follows. The must be run in the order nominated in
the "super" macro. We are working in Dutch, hence the field names may sound
strange. I have checked before and think that anything redundant may have
been already taken out, but no doubt there are still bits that can be
improved ... I'm always very happy to learn how to do macros better. Thanks
for all of your help and advice... RogerSub SortDossierOrder()
'
' SortDossierOrder Macro
' Sorts all akte records into 1. dossier number 2. date of akte 3. aktetype
order
' Deletes all records with "Doorstorting"
'
Cells.Select
Selection.sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("E2")
_
, Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=
_
xlSortNormal

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 2 Step -1
If Cells(i, "D") = "Doorstorting" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
End SubSub DeleteExtraRows()
'
' deletes records that are Retour or Geregeld

Dim cLastRow As Long
Dim i As Long
Dim IngLastRow As Long

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 2 Step -1
If Cells(i, "D") = "Retour" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 2 Step -1
If Cells(i, "D") = "Geregeld" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
Range("A2").Select
End SubSub DeleteDuplicates()
'
' DeleteDuplicates Macro
' Macro recorded 24/10/2009 by Roger Ottaway
' Retains only the last date record for a dossier and deletes other akte for
the dossier

Dim cLastRow As Long
Dim i As Long
Dim IngLastRow As Long

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 2 Step -1
If Cells(i, "B") = Cells(i - 1, "B") Then
Cells(i - 1, "A").EntireRow.Delete
End If
Next i

Range("A2").Select
End SubSub DeleteRecentRecords()
'
' DeleteRecentRecords Macro
' Macro recorded 24/10/2009 by Roger Ottaway
' Deletes records that are less than 28 day's old
' Sorts records into akte date order (oldest to most recent)

Dim cLastRow As Long
Dim i As Long
Dim IngLastRow As Long

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 2 Step -1
If Cells(i, "E") > (Now) - 28 Then
Cells(i, "A").EntireRow.Delete
End If
Next i
Cells.Select
Selection.sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2").Select
End Sub



Sub DeleteExtraCols()
'
' DeleteExtraCols Macro
' Macro recorded 24/10/2009 by Roger Ottaway
' Deletes two cols not needed, formats cols

Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 22.57
Columns("C:C").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("D:D").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 46.71
Range("A2").Select
End Sub
 
D

Dave Peterson

First, this compiled ok, but I didn't test it at all!

Option Explicit
Sub SortDossierOrder()
'
' SortDossierOrder Macro
' Sorts all akte records into 1. dossier number 2. date of akte 3. aktetype
' Order
' Deletes all records with "Doorstorting"

Dim wks As Worksheet
Dim FoundCell As Range

Set wks = ActiveSheet

With wks.Cells
'don't let excel guess at your headers.
'you know your data better than excel.
'(I used xlyes--change it if it's wrong.)
.Sort key1:=.Columns(1), order1:=xlAscending, _
key2:=.Columns(5), order2:=xlAscending, _
key3:=.Columns(3), order3:=xlAscending, _
header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal

'instead of looping through each cell
'just use .find
With .Range("D:D")
Do
Set FoundCell = .Cells.Find(what:="doorstotring", _
after:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
If FoundCell Is Nothing Then
Exit Do 'done looking
Else
FoundCell.EntireRow.Delete
End If
Loop
End With
End With

End Sub
Sub DeleteExtraRows()

Dim iCtr As Long
Dim wks As Worksheet
Dim myWords As Variant
Dim FoundCell As Range

myWords = Array("retour", "geregeld")

Set wks = ActiveSheet

With wks
For iCtr = LBound(myWords) To UBound(myWords)
With .Range("D:D")
Do
Set FoundCell = .Cells.Find(what:=myWords(iCtr), _
after:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
If FoundCell Is Nothing Then
Exit Do 'done looking
Else
FoundCell.EntireRow.Delete
End If
Loop
End With
Next iCtr
End With

End Sub
Sub DeleteDuplicates()
'
' DeleteDuplicates Macro
' Macro recorded 24/10/2009 by Roger Ottaway
' Retains only the last date record for a dossier and deletes other akte for
' the dossier

Dim cLastRow As Long
Dim iRow As Long
Dim IngLastRow As Long
Dim wks As Worksheet
Dim DelRng As Range

Set wks = ActiveSheet

With wks
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = cLastRow To 2 Step -1
If .Cells(iRow, "B").Value = Cells(iRow - 1, "B").Value Then
If DelRng Is Nothing Then
Set DelRng = .Cells(iRow, "B")
Else
Set DelRng = Union(DelRng, .Cells(iRow, "B"))
End If
End If
Next iRow

If DelRng Is Nothing Then
'do nothing
Else
DelRng.EntireRow.Delete
End If
End With
End Sub
Sub DeleteRecentRecords()
'
' DeleteRecentRecords Macro
' Macro recorded 24/10/2009 by Roger Ottaway
' Deletes records that are less than 28 day's old
' Sorts records into akte date order (oldest to most recent)

Dim cLastRow As Long
Dim iRow As Long
Dim wks As Worksheet
Dim DelRng As Range

Set wks = ActiveSheet

With wks
cLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = cLastRow To 2 Step -1
'if you only want to use the date (not including the time)
'If .Cells(i, "E").Value > Date - 28 Then
If .Cells(iRow, "E").Value > Now - 28 Then
If DelRng Is Nothing Then
Set DelRng = .Cells(iRow, "E")
Else
Set DelRng = Union(DelRng, .Cells(iRow, "E"))
End If
End If
Next iRow

If DelRng Is Nothing Then
'do nothing
Else
DelRng.EntireRow.Delete
End If

With .Cells
'don't let excel guess at your headers.
'you know your data better than excel.
'(I used xlyes--change it if it's wrong.)
.Sort key1:=.Columns(5), order1:=xlAscending, _
header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With

End With

End Sub
Sub DeleteExtraCols()
'
' DeleteExtraCols Macro
' Macro recorded 24/10/2009 by Roger Ottaway
' Deletes two cols not needed, formats cols

Dim wks As Worksheet

Set wks = ActiveSheet

With wks

.Range("A1:b1").EntireColumn.Delete

'it looks like A:D are all set the same way
'except for B and D columnwidths
With .Range("A:D")
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

.Range("B:B").ColumnWidth = 22.57
.Range("D:D").ColumnWidth = 46.71
End With

End Sub

I'm not quite sure why "doorstotring" isn't included in the other procedure that
deletes rows based on words. It seems like a natural fit there.

Maybe you sometimes run these procedures independently????

===================

Other things that can slow your code down...

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)
Call SortDossierOrder
call DeleteDuplicates
Call DeleteExtraRows
Call DeleteRecentRecords
call DeleteExtraCols

'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).
 
Ad

Advertisements

R

Roger

Re "Doorstorting" ... each record concerns some sort of action taken with a
dossier. Each dossier will have several (perhaps many) actions/records. The
dossier case can be closed with either action "retour" or "geregeld" in
which case all the records for the particular dossier can be deleted. The
trouble is that to determine if the dossier is closed we need to check for
"retour" or "geregeld" and use that as the indicator to delete the other
records for that dossier. To find r or g we sort into date order and look
for the r or g record as it appears as in 90% of cases it is the last action
taken. However, sometimes r or g is input as the "last" action and then a
day or two we remit some money "doorstorting". So the best way to resolve
this anomaly is to sort out the d's first, then the logic is okay to find
those dossiers which are truly closed. I hope this makes sense ... thanks ..
Roger
 
R

Roger

Thanks for all of your help.

Your first reply which turned off the screen
flickering etc works great and just doing that, with the better calling of
the macro's seems to have made it fast .. at least that is the impression.

I copied the below into a new macro, but I notice that each of my 5 macros
below still have the Sub name and End Sub included. If I leave that in the
paste it pastes as 5 macros, not one giant one. So I have made those lines
remarks, but it still won't run as I get a number of compile errors, for
example "duplicate declaration" for Dim wks as worksheet

I will need to print it out and have a look tomorrow for duplicates etc,
will get back to you then.

Thanks again .. Roger
 
D

Don Guillett

Untested but should do it. Similar savings available on your column macro

Sub insteadofcells()
lr = Cells.Find(What:="*", After:=[A1], _
SearchDirection:=xlPrevious).Row

lc = Cells.Find(What:="*", After:=[A1], _
SearchDirection:=xlPrevious).Column

Range(Cells(1, 1), Cells(lr, lc)).Sort Key1:=Range("B2"), _
Order1:=xlAscending, Key2:=Range("E2"), Order2:=xlAscending, _
Key3:=Range("C2"), Order3:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal

For i = lr To 2 Step -1
If Cells(i, "D") = "Doorstorting" Or _
Cells(i, "D") = "Retour" Or _
Cells(i, "D") = "Geregeld" Or _
Cells(i, "B") = Cells(i - 1, "B") Or _
Cells(i, "E") > (Now) - 28 Then
Rows(i).Delete
End If
Next i
End Sub
 
D

Dave Peterson

I'd keep all those "Sub/End Sub" statements.

And just call each "little" procedure from the procedure that does those 5
calls.
 
R

Roger

Ok, many thanks. I guess you have also answered my other question .... what
is faster, one giant macro with five little ones subsumed into it, or five
smaller macros run by one "coordinating" macro calling each of the smaller
ones one by one. From your reply it seems that it doesn't matter, what does
matter is that each macro is efficient in itself and doesn't contain
superfluous "code" which the macro wizard in excel automatically puts in. I
will keep the "5 smaller macros run by a coordinating macro" arrangement
simply because it is easier to manage what has to be done.
As you say, I know my spreadsheet better than excel, that is true. Thanks
for all of your help, very worthwhile

.... Roger
 
Ad

Advertisements

J

JLatham

It is probably better at this point to keep the 5 separate smaller macros for
a few reasons:
Each one performs a specific piece of the work and if you need to change the
way that one piece works in the future, having it as a separate function will
make the change easier to make.
No chance of one of the combined functions affecting the way any of the
others operates because of reusing one of the constants or variables in it.

There is only a little added overhead in calling the 5 routines individually.

Your biggest gains have probably already been made with the changes that
Dave Peterson and others have already provided: turning .ScreenUpdating off
is a huge one; referencing the sheets and cells via the Set method is another
major performance improvement, and using .Find instead of working through a
large loop are all things that should make it very efficient and fast.
 
Ad

Advertisements

D

Dave Peterson

I don't know which would be faster--but I bet the difference is too small to
notice.

But there comes a time when the speed of the execution isn't as important as
being able to understand and update the code.


Ok, many thanks. I guess you have also answered my other question .... what
is faster, one giant macro with five little ones subsumed into it, or five
smaller macros run by one "coordinating" macro calling each of the smaller
ones one by one. From your reply it seems that it doesn't matter, what does
matter is that each macro is efficient in itself and doesn't contain
superfluous "code" which the macro wizard in excel automatically puts in. I
will keep the "5 smaller macros run by a coordinating macro" arrangement
simply because it is easier to manage what has to be done.
As you say, I know my spreadsheet better than excel, that is true. Thanks
for all of your help, very worthwhile

... Roger
 

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