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
dguillett1.RemoveThis@austin.rr.com
"Dave Peterson" <petersod.RemoveThis@verizonXSPAM.net> wrote in message
news:4AE45A63.CDA47743@verizonXSPAM.net...
> 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

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

--JP

"Roger" <help-me DeleteThis @skynet.be> wrote in message
news:%238rlQjXVKHA.5368@TK2MSFTNGP02.phx.gbl...
>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
>

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").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" <jp2112 DeleteThis @earthlink.net> wrote in message
news:OYQBrkZVKHA.4704@TK2MSFTNGP06.phx.gbl...
> In addition to what Dave suggested, posting your code would allow others
> to make improvement suggestions.
>
> --JP
>
> "Roger" <help-me DeleteThis @skynet.be> wrote in message
> news:%238rlQjXVKHA.5368@TK2MSFTNGP02.phx.gbl...
>>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
>>
>

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")
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")
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 are all set the same way
'except for B and D columnwidths
With .Range("A")
.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").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").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" <jp2112 DeleteThis @earthlink.net> wrote in message
> news:OYQBrkZVKHA.4704@TK2MSFTNGP06.phx.gbl...
> > In addition to what Dave suggested, posting your code would allow others
> > to make improvement suggestions.
> >
> > --JP
> >
> > "Roger" <help-me DeleteThis @skynet.be> wrote in message
> > news:%238rlQjXVKHA.5368@TK2MSFTNGP02.phx.gbl...
> >>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

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" <petersod.TakeThisOut@verizonXSPAM.net> wrote in message
news:4AE49F06.43AA1D2C@verizonXSPAM.net...
> 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")
> 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")
> 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 are all set the same way
> 'except for B and D columnwidths
> With .Range("A")
> .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").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").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" <jp2112.TakeThisOut@earthlink.net> wrote in message
>> news:OYQBrkZVKHA.4704@TK2MSFTNGP06.phx.gbl...
>> > In addition to what Dave suggested, posting your code would allow
>> > others
>> > to make improvement suggestions.
>> >
>> > --JP
>> >
>> > "Roger" <help-me.TakeThisOut@skynet.be> wrote in message
>> > news:%238rlQjXVKHA.5368@TK2MSFTNGP02.phx.gbl...
>> >>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

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" <petersod.RemoveThis@verizonXSPAM.net> wrote in message
news:4AE49F06.43AA1D2C@verizonXSPAM.net...
> 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")
> 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")
> 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 are all set the same way
> 'except for B and D columnwidths
> With .Range("A")
> .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").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").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" <jp2112.RemoveThis@earthlink.net> wrote in message
>> news:OYQBrkZVKHA.4704@TK2MSFTNGP06.phx.gbl...
>> > In addition to what Dave suggested, posting your code would allow
>> > others
>> > to make improvement suggestions.
>> >
>> > --JP
>> >
>> > "Roger" <help-me.RemoveThis@skynet.be> wrote in message
>> > news:%238rlQjXVKHA.5368@TK2MSFTNGP02.phx.gbl...
>> >>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