Can formatting be done faster (vba)?

[Kappy]

I have the following code setup to easily print out a report that a system at my work generates..

It takes about 5 seconds to run, which I know is not soooo long.. but it seems like it should be nearly instaneous given the simplicity of the task.

Any suggestions on why its taking so long would be appreciated. Thanks.

Sub srPrintFormat()
Dim LastRow As Integer, LastColumn As Integer
Application.ScreenUpdating = False
LastRow = Range("C" & Rows.Count).End(xlUp).row
LastColumn = Cells(11, Columns.Count).End(xlToLeft).Column - 1
With ActiveSheet.PageSetup
.PrintArea = Range("C4", Cells(LastRow, LastColumn)).Address
.PrintTitleRows = "$4:$7"
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.1)
.BottomMargin = Application.InchesToPoints(0.1)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.Orientation = xlPortrait
End With
Application.ScreenUpdating = True
End Sub

 

[HalfAce]

I suspect (at least one) reason it takes that long might be because of other processes your computer is running at the same time.

I ran your code several times on this machine and it averages 2.85 seconds to run.

By simply removing the lines: (because they're not doing anything anyway)
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
it cut the average time down to 1.7 seconds.

 

[mikejvir]

One thing I have done is to set the default printer to write to a PDF. If you are running from a business with a intranet, setting the page setting requires acces to the spooler ove the intranet. Made a big difference for me.

Mike Virostko

 

[Kappy]

thanks both for your help..

unfortunately I do need the header/footer lines (as the report automatically generates huge headers/footers for all 6 spots..)

I guess it'll just be what it is

 

[ISY]

Hallo

May I suggest the following changes to accelerate the code:

Sub srPrintFormat()
    Dim LastRow As Integer, LastColumn As Integer
    Application.ScreenUpdating = False
    ActiveSheet.DisplayAutomaticPageBreaks = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    LastRow = Range("C" & Rows.Count).End(xlUp).Row
    LastColumn = Cells(11, Columns.Count).End(xlToLeft).Column - 1
    With ActiveSheet.PageSetup
        .PrintArea = Range("C4", Cells(LastRow, LastColumn)).Address
        If Not .PrintTitleRows = "$4:$7" Then .PrintTitleRows = "$4:$7"
        If Not .LeftHeader = "" Then .LeftHeader = ""
        If Not .CenterHeader = "" Then .CenterHeader = ""
        If Not .RightHeader = "" Then .RightHeader = ""
        If Not .LeftFooter = "" Then .LeftFooter = ""
        If Not .CenterFooter = "" Then .CenterFooter = ""
        If Not .RightFooter = "" Then .RightFooter = ""
        If Not .LeftMargin = Application.InchesToPoints(0) Then .LeftMargin = Application.InchesToPoints(0)
        If Not .RightMargin = Application.InchesToPoints(0) Then .RightMargin = Application.InchesToPoints(0)
        If Not .TopMargin = Application.InchesToPoints(0.1) Then .TopMargin = Application.InchesToPoints(0.1)
        If Not .BottomMargin = Application.InchesToPoints(0.1) Then .BottomMargin = Application.InchesToPoints(0.1)
        If Not .HeaderMargin = Application.InchesToPoints(0) Then .HeaderMargin = Application.InchesToPoints(0)
        If Not .FooterMargin = Application.InchesToPoints(0) Then .FooterMargin = Application.InchesToPoints(0)
        If Not .CenterHorizontally = True Then .CenterHorizontally = True
        If Not .Orientation = xlPortrait Then .Orientation = xlPortrait
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

[zookeepertx]

Hi Mike,

I have one macro that I have setting the page setting like the OP does, too, & it DOES take a little while to run. I don't get what you're suggesting here by "to write to a PDF". Doesn't that mean that, later, when my boss goes to print it, she'll have to change the default printer? And won't that then make it print in the wrong format? (I haven't done much at all with PDFs, so I have NO clue what I"m talking about, LOL!)

Jenny

One thing I have done is to set the default printer to write to a PDF. If you are running from a business with a intranet, setting the page setting requires acces to the spooler ove the intranet. Made a big difference for me.

Mike Virostko

 

[mikejvir]

Yes, I set the default printer to Adobe PDF or CutePDF. Since I run my formattiong macro every day, switching to the standard printer when I need paper copies make sense for me. If your boss in on a differnent computer from the Excel macro is being run, this will not be an issue.

PDF stands for Portable Document Format which Adobe pioneered in 1993.

 

[zookeepertx]

I don't mean to be dense, but do you have the macro assign the printer? Don't you have to specify settings for it?

Here's the part of my code that runs so slowly:

    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$7"
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
    End With

Thanks!

 

[mikejvir]

Hello,

No. I have a macro assigned to a hot key (CTRL - o). This reformats a Chart Tab with specific page information. This is my lastest code used in Excel 2007.

In Excel 2003 it took 12 seconds with a network LaserJet printer assigned as the default printer.
I assigned the default printer to Adobe PDF and the macro took under 1 second to run.

I move this to Excel 2007 and at first it took 30 seconds with the default printer assigned to Adobe PDF. I moved to Excel 2007 SP2 release and combined various element together so they did not have to be reselected and the time is down to 4 seconds.

The code below could be enchanced but it works for me.

For your code I would definitely put the following lines

Application.ScreenUpdating = False ' do all transfers in the background

Code

Application.ScreenUpdating = True 'Allow screen to updated.

Mike Virostko

Sub RF_Chart_page()
'
' Reformat_Chart_page Macro
' Macro recorded 1/27/2006 by Michael J. Virostko
' Revised 7/14/2011  for Excel 2007 speed.
' Set up Overall Page size along with the Header and Footers
'
    ActiveWindow.Zoom = 100
    ActiveChart.Activate
    Application.ScreenUpdating = False      ' do all transfers in the background
    Application.DisplayStatusBar = True
'
' Print Page Setup
'
    With ActiveChart.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = _
        "&""Times New Roman,Bold""COMPANY NAME" & Chr(10) & "&""Times New Roman,Regular""&8&F - &A"
        .CenterFooter = ""
 '       .RightFooter = "&10Page &P" & Chr(10) & "Printed " & "&D"
        .RightFooter = "&""Times New Roman,Bold""&10Page &P" & Chr(10) & "Printed " & "&D"
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.25)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .ChartSize = xlFullPage
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .BlackAndWhite = False
        .Zoom = 100
    End With

'For Excel 2007,  Need to define the Chart Area size and are
' Define the Chart area (no border)
'
'    ActiveChart.ChartArea.Select
    ActiveChart.ChartArea.Top = 0
    ActiveChart.ChartArea.Left = 0
    ActiveChart.ChartArea.Width = 745  '735
    ActiveChart.ChartArea.Height = 535 '530
    ActiveChart.ChartArea.Border.Weight = xlHairline
    ActiveChart.ChartArea.Border.LineStyle = xlNone
    ActiveChart.ChartArea.Shadow = False
    ActiveChart.ChartArea.Interior.ColorIndex = xlNone
'
' Define the area for the plot, needed only for Excel 2003
'
    If 1 = 1 Then
   ' ActiveChart.PlotArea.Select
        ActiveChart.PlotArea.Left = 25
        ActiveChart.PlotArea.Width = 695
        ActiveChart.PlotArea.Top = 50
        ActiveChart.PlotArea.Height = 450
    End If
'
' Set up graph to have only major gridlines
'
    ActiveChart.PlotArea.Select
    With ActiveChart.Axes(xlCategory)
        .HasMajorGridlines = True
        .HasMinorGridlines = False
    End With
    With ActiveChart.Axes(xlValue)
        .HasMajorGridlines = True
        .HasMinorGridlines = False
    End With
'
'  Format the plot area for white background, solid border.
'
'    ActiveChart.PlotArea.Select
    With Selection.Border
        .ColorIndex = 1
        .Weight = xlMedium
        .LineStyle = xlContinuous
    End With
    Selection.Interior.ColorIndex = xlNone

'
' Set up major gridlines to be a dashed line
'
'
'  xlCategory represents  x
'  xlvalue    represents  y
'
'  Format the y-axis
'
'    Selection.AutoScaleFont = True
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    With Selection.Border
        .ColorIndex = 57
        .Weight = xlHairline
        .LineStyle = xlDot
    End With
    ActiveChart.Axes(xlValue).AxisTitle.Select
    With Selection.Font
        .Name = "Times New Roman"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    ActiveChart.Axes(xlValue).Select
    With ActiveChart.Axes(xlValue)
'        .MinimumScale = 11.4
'        .MaximumScale = 14.9
'        .MinorUnit = 0.05
'        .MajorUnit = 0.5
        .Crosses = xlCustom
        .CrossesAt = -200
'        .ReversePlotOrder = False
'        .ScaleType = xlLinear
'        .DisplayUnit = xlNone
    End With

    With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlAutomatic
    End With
    With Selection
        .MajorTickMark = xlCross
        .MinorTickMark = xlInside
        .TickLabelPosition = xlNextToAxis
    End With
    Selection.TickLabels.AutoScaleFont = True
    With Selection.TickLabels.Font
        .Name = "Times New Roman"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
'    Selection.TickLabels.NumberFormat = "0"
'    Selection.TickLabels.NumberFormat = "0.0"
'
'  Format the x-axis
'
    ActiveChart.Axes(xlCategory).MajorGridlines.Select
    With Selection.Border
        .ColorIndex = 57
        .Weight = xlHairline
        .LineStyle = xlDot
    End With
    With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlAutomatic
    End With
    ActiveChart.Axes(xlCategory).Select
    With Selection
        .MajorTickMark = xlCross
        .MinorTickMark = xlInside
        .TickLabelPosition = xlLow
'        .MinimumScale = 0.6
'        .MaximumScale = 1.2
'        .MinorUnit = 0.01
'        .MajorUnit = 0.05
        .Crosses = xlCustom
        .CrossesAt = -200
        .ReversePlotOrder = False
   '     .ScaleType = xlLinear
        .DisplayUnit = xlNone
     End With

    Selection.TickLabels.AutoScaleFont = True
    With Selection.TickLabels.Font
        .Name = "Times New Roman"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
'    Selection.TickLabels.NumberFormat = "0.0"
'   Selection.TickLabels.NumberFormat = "0.00"
'    Selection.TickLabels.NumberFormat = "0"
    ActiveChart.Axes(xlCategory).AxisTitle.Select
    Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "Times New Roman"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
'
'  Format the Chart Title
'
    ActiveChart.ChartTitle.Select
    Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "Times New Roman"
        .FontStyle = "Bold"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    
    ActiveChart.Deselect
'
'  Reformat the various titles
'
    ActiveChart.Axes(xlCategory).AxisTitle.Select
    Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "Times New Roman"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .ReadingOrder = xlContext
        .Orientation = xlHorizontal
    End With
    ActiveChart.Axes(xlValue).AxisTitle.Select
    Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "Times New Roman"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .ReadingOrder = xlContext
        .Orientation = xlUpward
    End With
    ActiveChart.ChartTitle.Select
    Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "Times New Roman"
        .FontStyle = "Bold"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .ReadingOrder = xlContext
        .Orientation = xlHorizontal
    End With
'
' Force Legend to have a border, white soldid fill.
'
    ActiveChart.Legend.Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    Selection.Shadow = False
    With Selection.Interior
        .ColorIndex = 2
        .PatternColorIndex = 1
        .Pattern = xlSolid
    End With

'    Selection.Interior.ColorIndex = xlNone
    Selection.AutoScaleFont = False
    With Selection.Font
        .Name = "Times New Roman"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .Background = xlTransparent
    End With
    
    Application.ScreenUpdating = True      ' do all transfers in the background

End Sub

 

[zookeepertx]

This reformats a Chart Tab with specific page information.

Hmmm, I have ZERO experience with Charts & that coding looks WAY beyond me. Probably safer if I just stick to letting the macro take 8-10 seconds to run the way it is. If I mess it up, I'll hear about it forever!

Just color me chicken, heheh.

Jenny