One macro I use adds a name from a form into the header of 20-25 reports. The
procedure is called in Private Sub Worksheet_Change() as such:

'THIS LIMITS EXECUTION TO CHANGE IN SPECIFIC CELL
Dim mySheet As Worksheet
Set mySheet = Sheets("UserInfo")
Dim myName As Range
Set myName = mySheet.Range("F4")
If Not Intersect(Target, myName) Is Nothing Then
Call addHeader
End If

'THIS IS MACRO EXECUTED
Sub addHeader()
Dim Cell As Range
Dim myName, cName, myDate As String
myName = Sheets("UserInfo").Range("F4").value
cName = Sheets("UserInfo").Range("F24").value
myDate = Sheets("UserInfo").Range("F25").value
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Acquisition")
.PageSetup.RightHeader = "&""Tahoma,Regular""&8Prepared by: " _
& myName & ", " & myDate
.PageSetup.LeftHeader = "&""Tahoma,Regular""&8Prepared for: " _
& cName
End With
'''TOTAL OF 25 WS

The procedure takes about 10 seconds. Any ideas how I can reduce the time it
takes? TIA

Print formatting is very slow. Try changing the default printer to "Microsoft
Office Document Image Writer" before running the macro. It should update the
header much faster. You could even retrieve the current default printer at
the beginning of your macro using Application.ActivePrinter, store it in a
string variable, change the active printer to "Microsoft Office Document
Image Writer", update the headings, then restore the original printer.

Hope this helps,

Hutch

"JRK" wrote:

One macro I use adds a name from a form into the header of 20-25 reports. The
procedure is called in Private Sub Worksheet_Change() as such:

'THIS LIMITS EXECUTION TO CHANGE IN SPECIFIC CELL
Dim mySheet As Worksheet
Set mySheet = Sheets("UserInfo")
Dim myName As Range
Set myName = mySheet.Range("F4")
If Not Intersect(Target, myName) Is Nothing Then
Call addHeader
End If

'THIS IS MACRO EXECUTED
Sub addHeader()
Dim Cell As Range
Dim myName, cName, myDate As String
myName = Sheets("UserInfo").Range("F4").value
cName = Sheets("UserInfo").Range("F24").value
myDate = Sheets("UserInfo").Range("F25").value
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Acquisition")
.PageSetup.RightHeader = "&""Tahoma,Regular""&8Prepared by: " _
& myName & ", " & myDate
.PageSetup.LeftHeader = "&""Tahoma,Regular""&8Prepared for: " _
& cName
End With
'''TOTAL OF 25 WS

The procedure takes about 10 seconds. Any ideas how I can reduce the time it
takes? TIA

"Tom Hutchins" wrote:

Print formatting is very slow. Try changing the default printer to "Microsoft
Office Document Image Writer" before running the macro. It should update the
header much faster. You could even retrieve the current default printer at
the beginning of your macro using Application.ActivePrinter, store it in a
string variable, change the active printer to "Microsoft Office Document
Image Writer", update the headings, then restore the original printer.

Hope this helps,

Hutch

Thank you, Hutch. Yes, it MS Image Writer cuts it down to about 5 seconds
(in half). But this is an application i distribute to others, so how can I be
sure they have Image Writer, and how do I know what their default printer is?
It would help if you know. Thank you.


"JRK" wrote:

One macro I use adds a name from a form into the header of 20-25 reports. The
procedure is called in Private Sub Worksheet_Change() as such:

'THIS LIMITS EXECUTION TO CHANGE IN SPECIFIC CELL
Dim mySheet As Worksheet
Set mySheet = Sheets("UserInfo")
Dim myName As Range
Set myName = mySheet.Range("F4")
If Not Intersect(Target, myName) Is Nothing Then
Call addHeader
End If

'THIS IS MACRO EXECUTED
Sub addHeader()
Dim Cell As Range
Dim myName, cName, myDate As String
myName = Sheets("UserInfo").Range("F4").value
cName = Sheets("UserInfo").Range("F24").value
myDate = Sheets("UserInfo").Range("F25").value
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Acquisition")
.PageSetup.RightHeader = "&""Tahoma,Regular""&8Prepared by: " _
& myName & ", " & myDate
.PageSetup.LeftHeader = "&""Tahoma,Regular""&8Prepared for: " _
& cName
End With
'''TOTAL OF 25 WS

The procedure takes about 10 seconds. Any ideas how I can reduce the time it
takes? TIA

A couple of changes may help...
'--
With Worksheets("Acquisition")
Application.StatusBar = "Working on " & .Name '<<<<
.DisplayPageBreaks = False '<<<<

With .PageSetUp '<<<<
.RightHeader = "&""Tahoma,Regular""&8Prepared by: " _
& myName & ", " & myDate
.LeftHeader = "&""Tahoma,Regular""&8Prepared for: " _
& cName
End With
End With
'--
The StatusBar message can keep users from getting impatient and
pounding on the keyboard.
Turning off Pagebreaks can speed things up.
Eliminating a dot can't hurt.
--
Jim Cone
Portland, Oregon USA



"JRK"
wrote in message
One macro I use adds a name from a form into the header of 20-25 reports. The
procedure is called in Private Sub Worksheet_Change() as such:

'THIS LIMITS EXECUTION TO CHANGE IN SPECIFIC CELL
Dim mySheet As Worksheet
Set mySheet = Sheets("UserInfo")
Dim myName As Range
Set myName = mySheet.Range("F4")
If Not Intersect(Target, myName) Is Nothing Then
Call addHeader
End If

'THIS IS MACRO EXECUTED
Sub addHeader()
Dim Cell As Range
Dim myName, cName, myDate As String
myName = Sheets("UserInfo").Range("F4").value
cName = Sheets("UserInfo").Range("F24").value
myDate = Sheets("UserInfo").Range("F25").value
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Acquisition")
.PageSetup.RightHeader = "&""Tahoma,Regular""&8Prepared by: " _
& myName & ", " & myDate
.PageSetup.LeftHeader = "&""Tahoma,Regular""&8Prepared for: " _
& cName
End With
'''TOTAL OF 25 WS

The procedure takes about 10 seconds. Any ideas how I can reduce the time it
takes? TIA

"Jim Cone" wrote:

A couple of changes may help...
'--
With Worksheets("Acquisition")
Application.StatusBar = "Working on " & .Name '<<<<
.DisplayPageBreaks = False '<<<<

With .PageSetUp '<<<<
.RightHeader = "&""Tahoma,Regular""&8Prepared by: " _
& myName & ", " & myDate
.LeftHeader = "&""Tahoma,Regular""&8Prepared for: " _
& cName
End With
End With
'--
The StatusBar message can keep users from getting impatient and
pounding on the keyboard.
Turning off Pagebreaks can speed things up.
Eliminating a dot can't hurt.
--
Jim Cone
Portland, Oregon USA



Thank you, Jim, but it really had little (if any) effect.

Ok, since changing printers worked for you,
maybe this can help you find a printer on the user machine...
'--
'Lists printers/ports in a message box.
'Printers must be on a network for this to work.
Sub ListThem()
Dim WshNetwork As Object
Dim oPrinters As Variant
Dim strPrinterList As String
Dim i As Long

Set WshNetwork = CreateObject("WScript.Network")
Set oPrinters = WshNetwork.EnumPrinterConnections
For i = 0 To oPrinters.Count - 1 Step 2
strPrinterList = strPrinterList & oPrinters.Item(i + 1) & _
" on " & oPrinters.Item(i) & vbCr
Next 'i
Set WshNetwork = Nothing
MsgBox strPrinterList
End Sub
--
Jim Cone
Portland, Oregon USA



"JRK"
wrote in message
Thank you, Jim, but it really had little (if any) effect.

"Jim Cone" wrote:

Ok, since changing printers worked for you,
maybe this can help you find a printer on the user machine...
'--
'Lists printers/ports in a message box.
'Printers must be on a network for this to work.
Sub ListThem()
Dim WshNetwork As Object
Dim oPrinters As Variant
Dim strPrinterList As String
Dim i As Long

Set WshNetwork = CreateObject("WScript.Network")
Set oPrinters = WshNetwork.EnumPrinterConnections
For i = 0 To oPrinters.Count - 1 Step 2
strPrinterList = strPrinterList & oPrinters.Item(i + 1) & _
" on " & oPrinters.Item(i) & vbCr
Next 'i
Set WshNetwork = Nothing
MsgBox strPrinterList
End Sub
--
Jim Cone
Portland, Oregon USA



"JRK"
wrote in message
Thank you, Jim, but it's probably not worth the effort. I had hoped for something minor. On another note. Would you know how I can let someone preview a WS in Print Preview but not print it?

"but it's probably not worth the effort"
That why I gave you the code tweaks first.<g

I have no suggestions on not allowing printing from print preview;
--
Jim Cone
Portland, Oregon USA



"JRK"

wrote in message
Thank you, Jim, but it's probably not worth the effort. I had hoped for something minor. On another note. Would you know how I can
let someone preview a WS in Print Preview but not print it?