What code would I use to stop all calculations on all open workbooks
and reset to auto calculation on close?

I have a number of workbooks that copy info between each other with a
large amount of formula's within, its taking quite a while to run my
code, so perhaps turning off calculation would work for me. Note once
the info is copied-paste special-value I don't need any calculations
down

Hi

Sub test()
Application.Calculation = xlCalculationManual
'your things here
Application.Calculation = xlCalculationAutomatic
End Sub

HTH. Best wishes Harald


"Seanie" wrote in message
...
What code would I use to stop all calculations on all open workbooks
and reset to auto calculation on close?

I have a number of workbooks that copy info between each other with a
large amount of formula's within, its taking quite a while to run my
code, so perhaps turning off calculation would work for me. Note once
the info is copied-paste special-value I don't need any calculations
down

on 7/17/2010, Seanie supposed :
What code would I use to stop all calculations on all open workbooks
and reset to auto calculation on close?

I have a number of workbooks that copy info between each other with a
large amount of formula's within, its taking quite a while to run my
code, so perhaps turning off calculation would work for me. Note once
the info is copied-paste special-value I don't need any calculations
down

Here's what I use...

Public Sub EnableFastCode(Optional SetFast As Boolean = True)
With Application
If SetFast Then
.ScreenUpdating = False
.Calculation = xlCalculationManual
Else
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.Calculate '//update changes
End If
End With
End Sub

To use in code:

Sub MyProcess()
EnableFastCode 'turn off screen and calculation
'do your stuff
EnableFastCode False 'reset screen and calculation
End Sub

HTH

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Thanks Gary & Harald

Harald's code is effectively only 2 lines, does your code Gary do
things Harald's doesn't?

Gary also turns off screen updating (drawing the cells on screen), which
also speeds up execution. You spesifially asked for calculation so I left
that out.

1 line of code may well take a minute, but usually no time at all, so
counting code lines is not a useful measure of efficiency. Easy to write
seldom equals fast to run, and certainly never ever equals easy to use.

HTH. Best wishes Harald

"Seanie" wrote in message
...
Thanks Gary & Harald

Harald's code is effectively only 2 lines, does your code Gary do
things Harald's doesn't?

I have tried everything to speed up my code, below takes 20 minutes to
execute, 12 months ago this only took 3 minutes. I use XL 2007. Any
suggestions?

Sub Mail_New_Version()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim Sh As Worksheet
Dim strbody As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Set Sourcewb = ActiveWorkbook


'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("E-Total Hours", "E-Mail Current Week", "E-
Mail Project v Last Yr Actual", "E-Mail Actual v Last Year", "E-Mail
Comments", "e-Mail Excess", "E-Sales", "E-Splash", "E-Users")).Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security
dialog that you only
'see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
FileExtStr = ".xlsm": FileFormatNum = 52

End If
End If
End With

' 'Change all cells in the worksheets to values if you want
' For Each sh In Destwb.Worksheets
' sh.Select
' With sh.UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
' Destwb.Worksheets(1).Select
' Next sh

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-
mmm-yy h-mm") & "~"

ActiveWindow.TabRatio = 0.908


Sheets("E-Mail Current Week").Activate
Range("C6").Select
ActiveWindow.FreezePanes = True
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("E-Mail Project v Last Yr Actual").Activate
Range("C6").Select
ActiveWindow.FreezePanes = True
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("E-Mail Actual v Last Year").Activate
Range("C6").Select
ActiveWindow.FreezePanes = True
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("E-Mail Comments").Activate
Range("C6").Select
ActiveWindow.FreezePanes = True
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("e-Mail Excess").Activate
Range("C6").Select
ActiveWindow.FreezePanes = True
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("E-Sales").Activate
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("E-Total Hours").Activate
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"

Sheets("E-Users").Activate
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"



Sheets("E-Mail Current Week").Activate
Range("A1").Select

Call HideWorksheets

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

For Each cell In ThisWorkbook.Sheets("E-Mail Current
Week").Range("BF2:BF35")
strbody = strbody & cell.Value & vbNewLine
Next

For Each cell In ThisWorkbook.Sheets("E-Mail Current Week") _
.Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = strto
.Subject = ThisWorkbook.Sheets("E-Mail Current
Week").Range("BA1").Value
.Body = strbody
.Attachments.Add Destwb.FullName
.ReadReceiptRequested = True
If Sheets("E-Mail Current Week").Range("D192").Value 0
Then
.Importance = 2
Else
.Importance = 1
End If
.SendUsingAccount = OutApp.Session.Accounts.Item(3)
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Seanie presented the following explanation :
Thanks Gary & Harald

Harald's code is effectively only 2 lines, does your code Gary do
things Harald's doesn't?

As Harald states, he only provided an answer to your Q about turning
calculation off. I understood your Q to be wanting to know how to speed
up your code, and so I provided a reusable solution that I use for that
purpose. It requires a single line of code within any proc to enable or
disable it. The usage example I gave shows this!

To complete my answer to this thread, my reusable proc also turns
ScreenUpdating on/off to further speed things up.

As for the code you posted to Harald's thread below, I'm not surprised
that the proc takes so long to complete. There's just way too much
activation, selection, and other unnecessary 'dot processing' going on
that takes an appreciable amount more time to execute. You might want
to streamline that code to be more efficient as I don't see any reason
why it couldn't be lightning fast given what you're trying to do with
it<IMO.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Thanks, I've a mirror code in another workbook that takes about 15
seconds and the only difference is below


Sheets("E-Mail Current Week").Activate
Range("C6").Select
ActiveWindow.FreezePanes = True
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("E-Mail Project v Last Yr Actual").Activate
Range("C6").Select
ActiveWindow.FreezePanes = True
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("E-Mail Actual v Last Year").Activate
Range("C6").Select
ActiveWindow.FreezePanes = True
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("E-Mail Comments").Activate
Range("C6").Select
ActiveWindow.FreezePanes = True
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("e-Mail Excess").Activate
Range("C6").Select
ActiveWindow.FreezePanes = True
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("E-Sales").Activate
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"
Sheets("E-Total Hours").Activate
ActiveSheet.EnableSelection = xlNoSelection
ActiveSheet.Protect Password:="1234"

I have stripped down my code and the following is the problem, it
takes 20+ mins to execute. Some facts
Sourcewb = 1.8mb
Destwb = 950k (when it eventually copies)
I have set Calculation to Manual, Screenupdating & EnableEvents to
false

Can't see why copying out from one workbook to a new workbook even 9
sheets would take so long



'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("E-Total Hours", "E-Mail Current Week", "E-
Mail Project v Last Yr Actual", "E-Mail Actual v Last Year", "E-Mail
Comments", "e-Mail Excess", "E-Sales", "E-Splash", "E-Users")).Copy
Set Destwb = ActiveWorkbook

Seanie wrote :
I have stripped down my code and the following is the problem, it
takes 20+ mins to execute. Some facts
Sourcewb = 1.8mb
Destwb = 950k (when it eventually copies)
I have set Calculation to Manual, Screenupdating & EnableEvents to
false

Can't see why copying out from one workbook to a new workbook even 9
sheets would take so long



'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("E-Total Hours", "E-Mail Current Week", "E-
Mail Project v Last Yr Actual", "E-Mail Actual v Last Year", "E-Mail
Comments", "e-Mail Excess", "E-Sales", "E-Splash", "E-Users")).Copy
Set Destwb = ActiveWorkbook

Try this:

Const sWksList As String = "E-Total Hours,E-Mail Current Week,E-Mail
Project v Last Yr Actual,E-Mail Actual v Last Year,E-Mail
Comments,e-Mail Excess,E-Sales,E-Splash"
vWksList = Split(sWksList, ",")

'Copy the sheets to a new workbook
EnableFastCode
Application.DisplayAlerts = False
Set wkbTarget = ActiveWorkbook.Sheets(vWksList).Copy
Application.DisplayAlerts = True

Watch for wordwrap on the (local) Const declaration.

Also, here's another way to do the formatting:

For Each Wks In wkbTarget.Sheets
With Wks
.Activate
bSetFreezePanes Wks.Range("C6").Column, Wks.Range("C6").Row
.EnableSelection = xlNoSelection
.Protect Password:="1234"
End With
Next Wks

Function bSetFreezePanes(lColumn As Long, lRow As Long, Optional bSet
As Boolean = True) As Boolean
On Error GoTo ErrExit
With ActiveWindow
.SplitColumn = lColumn
.SplitRow = lRow
.FreezePanes = bSet
End With
ErrExit:
bSetFreezePanes = (Err = 0)
End Function

Notice that it doesn't require selecting anything.

And.., here's how I would do the formula conversions to values:

'Change all cells in the worksheets to values if you want
' For Each Wks In wkbTarget.Worksheets
' With Wks.UsedRange: .Value = .Value: End With
' Next Wks

HTH

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Thanks Gary for taking the time to reply, unfortunately there is no
difference, using only the code below takes 20mins. I don't know what
is wrong, but its mighty frustrating

Const sWksList As String = "E-Total Hours,E-Mail Current Week,E-Mail
Project v Last Yr Actual,E-Mail Actual v Last Year,E-Mail Comments,e-
Mail Excess,E-Sales,E-Splash"
vWksList = Split(sWksList, ",")


'Copy the sheets to a new workbook
'EnableFastCode
Application.DisplayAlerts = False
Set wkbTarget = ActiveWorkbook.Sheets(vWksList).Copy
Application.DisplayAlerts = True

A couple of things to test:

In every sheet to be copied, go there and click Ctrl End, which brings you
to the last cell. Is it far below the real used range?

Does the workbook to be copied have many defined names in it?

What happens when you don't set Displayalerts to false ?

Best wishes Harald

"Seanie" wrote in message
...
Thanks Gary for taking the time to reply, unfortunately there is no
difference, using only the code below takes 20mins. I don't know what
is wrong, but its mighty frustrating

Const sWksList As String = "E-Total Hours,E-Mail Current Week,E-Mail
Project v Last Yr Actual,E-Mail Actual v Last Year,E-Mail Comments,e-
Mail Excess,E-Sales,E-Splash"
vWksList = Split(sWksList, ",")


'Copy the sheets to a new workbook
'EnableFastCode
Application.DisplayAlerts = False
Set wkbTarget = ActiveWorkbook.Sheets(vWksList).Copy
Application.DisplayAlerts = True

In every sheet to be copied, go there and click Ctrl End, which brings
you
to the last cell. Is it far below the real used range? ..... No,
ranges are fine


Does the workbook to be copied have many defined names in it? .....
Yes it does and a lot of conditional formatting also. I create each
sheet I am copying above using code like the following. Which to my
knowledge just copies-pasteSpecial values only

Sheets("Current Week").Select
Cells.Select
Selection.Copy
Sheets("E-Mail Current Week").Select
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Cells.Select
Selection.Locked = True
ActiveSheet.EnableSelection = xlNoSelection
Range("C6").Select
Application.CutCopyMode = False


What happens when you don't set Displayalerts to false ? ... Have to
check this tomorrow

Seanie brought next idea :
Thanks Gary for taking the time to reply, unfortunately there is no
difference, using only the code below takes 20mins. I don't know what
is wrong, but its mighty frustrating

Const sWksList As String = "E-Total Hours,E-Mail Current Week,E-Mail
Project v Last Yr Actual,E-Mail Actual v Last Year,E-Mail Comments,e-
Mail Excess,E-Sales,E-Splash"
vWksList = Split(sWksList, ",")


'Copy the sheets to a new workbook
'EnableFastCode
Application.DisplayAlerts = False
Set wkbTarget = ActiveWorkbook.Sheets(vWksList).Copy
Application.DisplayAlerts = True

Is there any reason why you can't just save the workbook to another
filename and do your changes to the new file? IOW, why do you need to
copy the sheets to a new workbook?

Also, in reply to your admission that there are a lot of defined names
involved, are these local, global, or a mix?

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Oki. Remove all names from the source and time the copy operation again.



"Seanie" wrote in message
...
In every sheet to be copied, go there and click Ctrl End, which brings
you
to the last cell. Is it far below the real used range? ..... No,
ranges are fine


Does the workbook to be copied have many defined names in it? .....
Yes it does and a lot of conditional formatting also. I create each
sheet I am copying above using code like the following. Which to my
knowledge just copies-pasteSpecial values only

Sheets("Current Week").Select
Cells.Select
Selection.Copy
Sheets("E-Mail Current Week").Select
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Cells.Select
Selection.Locked = True
ActiveSheet.EnableSelection = xlNoSelection
Range("C6").Select
Application.CutCopyMode = False


What happens when you don't set Displayalerts to false ? ... Have to
check this tomorrow

Garry / Harald

Thanks for your advice, everything sorted, Reports goes in seconds
now. What happened was that I copy from a source sheet(s) to a
destination sheet each day (for the last 8 years) and what I didn't
realise was that I was duplicating CF each day on the CF, I need the
CF for presentation purposes but didn't think I new CF was being added
each day, so now I've cleared this out and going forward I simple
delete the CF before I copy each day now

Thanks again