![]() |
Better codes to run faster?
Hi all, My codes belows take more than 2 minutes to run the file. I believe with better codes it will run faster. Appreciate any advise or suggestion. Sub DebtorMaster() On Error Resume Next Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = False Range("A7").Select Selection.RemoveSubtotal Range("A4").Select Range("SalesData.xls!Sales").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A3:I4"), CopyToRange:=Range("A6:K6"), Unique:=False Range("A4:I4").Copy Range("A7").Select Workbooks.Open Filename:="C:\My Documents\Master.xls" Sheets("Sheet2").Range("A2").Select ActiveSheet.Paste Range("A2").Select Application.Run "Master.xls!Masterlist" Range("'Master.xls'!Masteroutput").Select Selection.Copy Application.DisplayAlerts = False ActiveWorkbook.Close Application.DisplayAlerts = True Windows("SalesData.xls").Activate Range("A7").Select Selection.End(xlDown).Offset(1, 0).Select ActiveSheet.Paste Range("A7").Select Selection.Sort Key1:=Range("E7"), Order1:=xlAscending, Key2:=Range("F7") _ , Order2:=xlAscending, Key3:=Range("C7"), Order3:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(7, 8, 9), _ Replace:=True, PageBreaks:=True, SummaryBelowData:=True Selection.AutoFormat Format:=xlRangeAutoFormatSimple Dim lastrow As String lastrow = ActiveSheet.Range("E65536").End(xlUp).Row ActiveSheet.PageSetup.PrintArea = "$A$7:$K$" & lastrow CreateObject("WScript.Shell").Popup "Please preview the page setting is correct," + Chr(10) & "then click PRINT to print the Debtors List", 10, "Printing" End Sub -- taych ------------------------------------------------------------------------ taych's Profile: http://www.excelforum.com/member.php...fo&userid=7096 View this thread: http://www.excelforum.com/showthread...hreadid=494342 |
Better codes to run faster?
taych,
What does it do? Jim Cone San Francisco, USA "taych" wrote in message Hi all, My codes belows take more than 2 minutes to run the file. I believe with better codes it will run faster. Appreciate any advise or suggestion. Sub DebtorMaster() On Error Resume Next Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = False Range("A7").Select Selection.RemoveSubtotal Range("A4").Select Range("SalesData.xls!Sales").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A3:I4"), CopyToRange:=Range("A6:K6"), Unique:=False Range("A4:I4").Copy Range("A7").Select Workbooks.Open Filename:="C:\My Documents\Master.xls" Sheets("Sheet2").Range("A2").Select ActiveSheet.Paste Range("A2").Select Application.Run "Master.xls!Masterlist" Range("'Master.xls'!Masteroutput").Select Selection.Copy Application.DisplayAlerts = False ActiveWorkbook.Close Application.DisplayAlerts = True Windows("SalesData.xls").Activate Range("A7").Select Selection.End(xlDown).Offset(1, 0).Select ActiveSheet.Paste Range("A7").Select Selection.Sort Key1:=Range("E7"), Order1:=xlAscending, Key2:=Range("F7") _ , Order2:=xlAscending, Key3:=Range("C7"), Order3:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(7, 8, 9), _ Replace:=True, PageBreaks:=True, SummaryBelowData:=True Selection.AutoFormat Format:=xlRangeAutoFormatSimple Dim lastrow As String lastrow = ActiveSheet.Range("E65536").End(xlUp).Row ActiveSheet.PageSetup.PrintArea = "$A$7:$K$" & lastrow CreateObject("WScript.Shell").Popup "Please preview the page setting is correct," + Chr(10) & "then click PRINT to print the Debtors List", 10, "Printing" End Sub taych |
Better codes to run faster?
Hi Jim, This program generate the Debtors' List for viewing and printing. It populates data from two workbooks (SalesData & Master), combines and sorts them by states, towns and customers with info like sales person ID, days and amount of outstanding, etc. Then it sets print area with a popup message to remind the user to check the print area setting before printing. Hope you get the rough picture. Thanks. -- taych ------------------------------------------------------------------------ taych's Profile: http://www.excelforum.com/member.php...fo&userid=7096 View this thread: http://www.excelforum.com/showthread...hreadid=494342 |
Better codes to run faster?
taych wrote: Hi all, My codes belows take more than 2 minutes to run the file. I believe with better codes it will run faster. Appreciate any advise or suggestion. Sub DebtorMaster() On Error Resume Next Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = False Range("A7").Select Selection.RemoveSubtotal Range("A4").Select Range("SalesData.xls!Sales").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A3:I4"), CopyToRange:=Range("A6:K6"), Unique:=False Range("A4:I4").Copy Range("A7").Select Workbooks.Open Filename:="C:\My Documents\Master.xls" Sheets("Sheet2").Range("A2").Select ActiveSheet.Paste Range("A2").Select Application.Run "Master.xls!Masterlist" Range("'Master.xls'!Masteroutput").Select Selection.Copy Application.DisplayAlerts = False ActiveWorkbook.Close Application.DisplayAlerts = True Windows("SalesData.xls").Activate Range("A7").Select Selection.End(xlDown).Offset(1, 0).Select ActiveSheet.Paste Range("A7").Select Selection.Sort Key1:=Range("E7"), Order1:=xlAscending, Key2:=Range("F7") _ , Order2:=xlAscending, Key3:=Range("C7"), Order3:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(7, 8, 9), _ Replace:=True, PageBreaks:=True, SummaryBelowData:=True Selection.AutoFormat Format:=xlRangeAutoFormatSimple Dim lastrow As String lastrow = ActiveSheet.Range("E65536").End(xlUp).Row ActiveSheet.PageSetup.PrintArea = "$A$7:$K$" & lastrow CreateObject("WScript.Shell").Popup "Please preview the page setting is correct," + Chr(10) & "then click PRINT to print the Debtors List", 10, "Printing" End Sub -- taych ------------------------------------------------------------------------ taych's Profile: http://www.excelforum.com/member.php...fo&userid=7096 View this thread: http://www.excelforum.com/showthread...hreadid=494342 Hi A few comments: 1) You could try Application.ScreenUpdating = False at the beginning of your code (setting it back to true at the end). This often has a noticable effect. 2) Some (all?) of the selections can be removed. For example the two lines Range("A7").Select Selection.RemoveSubtotal can be replaced by Range("A7").RemoveSubtotal 3) Why the WScript popup? VBA has a MsgBox with similar (or even identitical) functionality. That will save the time needed to create an object reference. But ... even with all these suggestions, I suspect that the line that is killing you timewise is Application.Run "Master.xls!Masterlist" Maybe optimizing that sub would help. Hope this helps -John Coleman |
Better codes to run faster?
taych,
The following sets Calculation to manual and removes some unneeded "selects". If the program still takes excessive time then determine how long the "Masterlist" sub is taking. Also, error handling was changed to create a "beep" if an error occurs. Listening for that may tell you something. I could not test the modified code. Jim Cone San Francisco, USA '-------------------------------- Sub DebtorMaster() On Error GoTo BadDebt Dim LastRow As Long Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Range("A7").RemoveSubtotal Range("SalesData.xls!Sales").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A3:I4"), CopyToRange:=Range("A6:K6"), Unique:=False Range("A4:I4").Copy Workbooks.Open Filename:="C:\My Documents\Master.xls" Sheets("Sheet2").Range("A2").Select ActiveSheet.Paste Application.Run "Master.xls!Masterlist" Range("'Master.xls'!Masteroutput").Copy ActiveWorkbook.Close savechanges:=False Windows("SalesData.xls").Activate Range("A7").Select ActiveSheet.Paste Selection.Sort Key1:=Range("E7"), Order1:=xlAscending, Key2:=Range("F7"), _ Order2:=xlAscending, Key3:=Range("C7"), Order3:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(7, 8, 9), _ Replace:=True, PageBreaks:=True, SummaryBelowData:=True Selection.AutoFormat Format:=xlRangeAutoFormatSimple LastRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row ActiveSheet.PageSetup.PrintArea = Range("$A$7", Cells(11, LastRow)).Address CreateObject("WScript.Shell").Popup "Please preview the page setting is correct," & _ Chr(10) & "then click PRINT to print the Debtors List", 10, "Printing" Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Exit Sub BadDebt: Beep Resume Next End Sub '------------------------------ "taych" wrote in message Hi Jim, This program generate the Debtors' List for viewing and printing. It populates data from two workbooks (SalesData & Master), combines and sorts them by states, towns and customers with info like sales person ID, days and amount of outstanding, etc. Then it sets print area with a popup message to remind the user to check the print area setting before printing. Hope you get the rough picture. Thanks. taych |
Better codes to run faster?
Thanks guys for the advices and tips. Jim, I copied your codes to the application, and it took around 12 seconds to run, but it excluded data from Master.xls and also a popup about "Large amount of info in the clipboard, do you want to be able to paste to another program later?". However, following the arrangement of your codes, I replaced "Application.Calculation = xlCalculationAutomatic" with "Application.Calculation = xlCalculationManual" at the beginning and put it at the end with another code "Application.ScreenUpdating = True" before "End Sub" to my original codes, without changing anything elses. Now my codes ran as fast (12 sec) with all the data from both workbooks. Thanks again, I am really appreciated. -- taych ------------------------------------------------------------------------ taych's Profile: http://www.excelforum.com/member.php...fo&userid=7096 View this thread: http://www.excelforum.com/showthread...hreadid=494342 |
All times are GMT +1. The time now is 08:01 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com