Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 15
Default How can my macro run faster ?

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


  #2   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 35,218
Default How can my macro run faster ?

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

Roger wrote:

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
  #3   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 10,124
Default How can my macro run faster ?

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.


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Dave Peterson" wrote in message
...
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

Roger wrote:

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


  #4   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 897
Default How can my macro run faster ?

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


  #5   Report Post  
Posted to microsoft.public.excel.newusers
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






  #6   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 35,218
Default How can my macro run faster ?

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
  #7   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 15
Default How can my macro run faster ?

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

"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



  #8   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 15
Default How can my macro run faster ?

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




  #9   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 10,124
Default How can my macro run faster ?

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

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Roger" wrote in message
...
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





  #10   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 35,218
Default How can my macro run faster ?

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


  #11   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 15
Default 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



  #12   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 2,203
Default How can my macro run faster ?

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.

"Roger" wrote:

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.

  #13   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 35,218
Default How can my macro run faster ?

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.



Roger wrote:

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


--

Dave Peterson
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Can be here some changes for a faster speed ? ytayta555 Excel Worksheet Functions 3 July 30th 08 06:42 PM
WHY the same macro runs so slowly on a different but faster comput Jerry Excel Discussion (Misc queries) 2 August 15th 07 10:30 PM
can this be done faster? Frank Excel Discussion (Misc queries) 7 August 9th 07 10:02 PM
Can faster CPU+larger/faster RAM significantly speed up recalulati jmk_li Excel Discussion (Misc queries) 2 September 28th 05 10:24 AM
better/faster way than sum products? alex Excel Worksheet Functions 2 November 17th 04 11:56 AM


All times are GMT +1. The time now is 06:31 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"