need to speed up some page formatting code

[Brite]

Hi,

I was wondering if there is a better way of running the following code
because as it is, it is really slowing up the macro i am creating. I will
need to run this code on approximately 20 sheets, but not all the sheets are
the same so i can't just select all the sheets at the same time and do it
that way. So the following set of code gets run whenever one of the 20 sheets
gets created.

Does anyone have any pointers?

thanks in advance!

Worksheets(1).Cells.Font.Name = "Arial Narrow"
Worksheets(1).Columns("A:A").ColumnWidth = 1.5
Worksheets(1).Columns("B:C").ColumnWidth = 16
Worksheets(1).Columns("D:O").ColumnWidth = 10
Worksheets(1).Columns("D:O").NumberFormat = "_(* #,##0_);_(* (#,##0);_(*
""-""_);_(@_)"
Worksheets(1).Rows("1:9").NumberFormat = "General"
With Worksheets(1).PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.4)
.RightMargin = Application.InchesToPoints(0.4)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
'.PrintQuality = -3
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 80
'.PrintErrors = xlPrintErrorsDisplayed
End With

 

[Mike]

Try this I changed From Worksheet(1) to ActiveSheet this way what ever sheet
is active you could run macro
Sub helpSpeedupFormating()
Application.ScreenUpdating = False 'Turn off to help speed things up

ActiveSheet.Cells.Font.Name = "Arial Narrow"
ActiveSheet.Columns("A:A").ColumnWidth = 1.5
ActiveSheet.Columns("B:C").ColumnWidth = 16
ActiveSheet.Columns("D:O").ColumnWidth = 10
ActiveSheet.Columns("D:O").NumberFormat = "_(* #,##0_);_(* (#,##0);_(*
""-""_);_(@_)"
ActiveSheet.Rows("1:9").NumberFormat = "General"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.4)
.RightMargin = Application.InchesToPoints(0.4)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
'.PrintQuality = -3
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 80
'.PrintErrors = xlPrintErrorsDisplayed
End With
Application.ScreenUpdating = True 'Always good to turn on what we turn off
End Sub

 

[Tom Ogilvy]

Each page setup command is run as an individual command. You need to remove
commands you don't need. If you are adding a sheet, good bet it doesn't
have any header or footers defined, so you don't need to run those 6 commands
(as an example).

Also, using the xl4 macro equivalents are faster as shown in this post by
John Green:

=================================
From: John Green ([email protected])
Subject: Re: About PageSetup..
Newsgroups: microsoft.public.excel.programming
View complete thread (10 articles)
Date: 2001-01-22 12:57:23 PST




PageSetup in VBA has always been a painfully slow process. If you can't
avoid having
to set these parameters, you can use the Excel 4 macro function, PAGE.SETUP
to carry
out most of the PageSetup operations much more quickly. The following two
macros are
almost equivalent, and should give you the clues you need to start using
PAGE.SETUP.
You can download a full description of all the Excel 4 macro functions from
Microsoft's web site:

Sub PS()
ActiveSheet.DisplayPageBreaks = False
With ActiveSheet.PageSetup
.LeftHeader = "My Company"
.CenterHeader = ""
.RightHeader = "&D / &T"
.LeftFooter = "Highly Confidential and Proprietary"
.CenterFooter = ""
.RightFooter = "Finance"
.LeftMargin = Application.InchesToPoints(0.54)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.36)
.HeaderMargin = Application.InchesToPoints(0.22)
.FooterMargin = Application.InchesToPoints(0.17)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
' .PrintQuality = 600 ' does not work with all the printers
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Sub

Sub PS4()
head = """&LMy Company&R&D / &T"""
foot = """&LHighly Confidential and Proprietary&RFinance"""
pLeft = 0.54
pRight = 0.3
Top = 0.4
bot = 0.36
head_margin = 0.22
foot_margin = 0.17
hdng = False
grid = False
notes = False
quality = ""
h_cntr = False
v_cntr = False
orient = 2
Draft = False
paper_size = 1
pg_num = """Auto"""
pg_order = 1
bw_cells = False
pscale = True
pSetUp = "PAGE.SETUP(" & head & "," & foot & "," & pLeft & "," & pRight &
","
pSetUp = pSetUp & Top & "," & bot & "," & hdng & "," & grid & "," & h_cntr
& ","
pSetUp = pSetUp & v_cntr & "," & orient & "," & paper_size & "," & pscale
& ","
pSetUp = pSetUp & pg_num & "," & pg_order & "," & bw_cells & "," & quality
& ","
pSetUp = pSetUp & head_margin & "," & foot_margin & "," & notes & "," &
Draft & ")"

Application.ExecuteExcel4Macro pSetUp
End Sub

John Green (Excel MVP)
Sydney
Australia

 

[Susan]

in addition, you don't have to list the values you AREN'T
changing.......
for instance, these are default:

With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 400
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With

so you could considerably shorten your code by eliminating the ones
you aren't changing, i.e.,
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.PrintQuality = 400
.Orientation = xlLandscape
.Zoom = 100
End With

these are the only values you are changing in your code.
hth!
susan