Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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
Posted to microsoft.public.excel.newusers
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can be here some changes for a faster speed ? | Excel Worksheet Functions | |||
WHY the same macro runs so slowly on a different but faster comput | Excel Discussion (Misc queries) | |||
can this be done faster? | Excel Discussion (Misc queries) | |||
Can faster CPU+larger/faster RAM significantly speed up recalulati | Excel Discussion (Misc queries) | |||
better/faster way than sum products? | Excel Worksheet Functions |