Better codes to run faster?

**taych** · 12-17-2005, 11:03 AM

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

Jim Cone · 12-17-2005, 04:00 PM

taych,
What does it do?
Jim Cone
San Francisco, USA

"taych" <[email protected]>
wrote in message
news:[email protected]
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** · 12-18-2005, 02:09 AM

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.

John Coleman · 12-18-2005, 08:40 AM

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

Jim Cone · 12-18-2005, 09:15 AM

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

**taych** · 12-18-2005, 10:59 PM

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.