Better codes to run faster?

  • Thread starter Thread starter taych
  • Start date Start date
T

taych

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,
What does it do?
Jim Cone
San Francisco, USA

"taych" <[email protected]>
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
 
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 said:
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
Click to expand...

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
 
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
'------------------------------


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
 
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.
 
Back
Top