How can my macro run faster ?
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
"Dave Peterson" wrote in message
...
I'd keep all those "Sub/End Sub" statements.
And just call each "little" procedure from the procedure that does those 5
calls.
Roger wrote:
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
"Dave Peterson" wrote in message
...
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).
Roger wrote:
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... Roger
Sub 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 Sub
Sub 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 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 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 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 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
"JP" wrote in message
...
In addition to what Dave suggested, posting your code would allow
others
to make improvement suggestions.
--JP
"Roger" wrote in message
...
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
--
Dave Peterson
--
Dave Peterson
|