How can my macro run faster ?
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
|