View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.newusers
Roger[_2_] Roger[_2_] is offline
external usenet poster
 
Posts: 15
Default 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