Looking for help optimizing a program. The program prints a dashboard and allows the end user to pick the range with a message box, specify number of printouts and print preview (yes or no).
The program does precisely what I want it to do; however, it does it extremely slowly.
Specifically there are two things that seem to be slowing it down 1) setting the header/footer and 2) setting the active sheet properties. Each of these steps is taking about 5 full seconds to run. >10 seconds to run a print macro is just too long!
The full code is:
Option Explicit
Sub PRINT_DASHBOARD()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' Definitions;
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim LtHdr, CntHdr, RtHdr, Pgs, prvw
LtHdr = Range("FISCAL_YEAR")
CntHdr = Range("PRACTICE")
RtHdr = "Q U A L I T Y D A T A"
Dim p As Range
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
strPrompt = "Do You Want To Print with Comments?" ' my prompt
strTitle = "Print With Comments Option" ' prompt message
iRet = MsgBox(strPrompt, vbYesNo, strTitle) ' message box
If iRet = vbNo Then ' check user selection
Set p = Range("A3:N64")
Else
Set p = Range("A3:Z64")
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' manage alerts; Set to False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Application
.ScreenUpdating = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' manage headers; ~5 seconds
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With ActiveSheet.PageSetup
.LeftHeader = LtHdr
.CenterHeader = CntHdr
.RightHeader = RtHdr
.LeftFooter = "&F"
.CenterFooter = "&P of &N"
.RightFooter = "&T"
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' NUMBER OF PRINTOUTS;
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Pgs = InputBox("How Many Copies Do You Need?", "NUMBER OF COPIES TO PRINT", 1)
If Pgs < 1 Or Pgs = "" Then Pgs = 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' PRINT PREVIEW YES OF NO?
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
prvw = MsgBox("Do You Want To Preview Your Printout?", _
vbYesNo, "Print Preview Option")
If prvw = vbYes Then
prvw = True
ElseIf prvw = vbNo Then
prvw = False
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' ACTIVESHEET PROPERTIES; ~5 seconds
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 3
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' SELECT RANGE FOR PRINT AREA
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
p.PrintOut Copies:=Pgs, Preview:=prvw, Collate:=False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' manage alerts;
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.ScreenUpdating = True
End With
End Sub
If I remove:
With ActiveSheet.PageSetup
.LeftHeader = LtHdr
.CenterHeader = CntHdr
.RightHeader = RtHdr
.LeftFooter = "&F"
.CenterFooter = "&P of &N"
.RightFooter = "&T"
End With
and:
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 3
End With
The program is fast as expected.
Any thoughts on how I can change or modify this so it's not so slow but still allows me to set the header/footer and active sheet properties?
Any help is appreciated.
Thanks!!!
Bookmarks