Macro to format multiple worksheets

[Chutney]

I have a workbook the has 60 worksheets (created by Access). I need a
macro to format the title row, auto-size the columns, and set the
print settings on each worksheet. All of the settings are identical
for all of the worksheets.

I have tried to create a macro to do this. The macro will format all
of the title rows on all of the worksheets but it sets the column
widths and print settings only on the first (active) worksheet. I have
searched the forums about this but the only solution I have found is
to iterate through all of the worksheets and set them one-by-one. That
takes forever. I can manually select all of the worksheets and do all
of the settings in one go far faster faster than using a macro to
iterate through each of the worksheets but I need to automate this
process. Any suggests about how to get Excel to do programatically and
efficiently what I can do manually?

This is my current macro. I want to eliminate the iteration or, if
that is not possible, make it run as efficiently as possible:

Sub Format_Worksheets()

Application.Visible = False
Application.ScreenUpdating = False

'Create variables
Dim iGroupNo As Integer
Dim oWS As Worksheet
Dim sGroup As String
'Set format of column title cells for all worksheets
Worksheets.Select 'select all worksheets in workbook
Worksheets(1).Activate 'can activate only one sheet at a time
but formats apply to all selected sheets
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Selection.Font.Bold = True
'Set print format and column widths for each individual worksheet
iGroupNo = 0
For Each oWS In Worksheets
iGroupNo = iGroupNo + 1
sGroup = "Group " & iGroupNo
oWS.Activate
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.LeftHeader = "Printed: &D"
.CenterHeader = "Report for: &A"
.RightHeader = "Page &P of &N"
.CenterFooter = ""
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
End With
ActiveSheet.Cells.Select
Selection.EntireColumn.AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True
Next oWS
Worksheets(1).Activate
Range("A2").Select
Application.Visible = True
Application.ScreenUpdating = True

End Sub

 

[GS]

The problem here is that grouping sheets in VBa doesn't behave the same
as grouping in the UI. What's going to take forever is doing PageSetup
because (via VBa) you have to do that for each sheet. You might be
better off to format the sheets via VBa and do PageSetup on the group
via the UI. Here's 2 procedures to do both separately.

Sub FormatWorksheets()
Dim lNumCols As Long, wks As Variant

With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual
End With '//Application
For Each wks In ActiveWorkbook.Worksheets
Application.StatusBar = "Formatting " & wks.Name
With wks
.Activate
With .Cells(1, 1)
lNumCols = .End(xlToRight).Column
With .Resize(1, lNumCols)
.Interior.ColorIndex = 15: .Font.Bold = True
.EntireColumn.AutoFit
End With '//.Resize(1, lNumCols)
.Offset(1).Activate
End With '//.Cells(1, 1)
ActiveWindow.FreezePanes = True
End With '//wks
Next
' DoPageSetup
With Application
.StatusBar = "": .ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With '//Application
End Sub

Sub DoPageSetup()
Dim wks As Variant
For Each wks In ActiveWorkbook.Sheets
With wks.PageSetup
.Orientation = xlLandscape: .PrintTitleRows = "$1:$1"
.LeftHeader = "Printed: &D"
.CenterHeader = "Report for: &A"
.RightHeader = "Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.FitToPagesWide = 1: .FitToPagesTall = 100
End With '//wks.PageSetup
Next '//wks
End Sub

 

[Jim Cone]

Sub Format_Worksheets_R1()
Dim N As Long
Dim oWS As Worksheet

Application.ScreenUpdating = False
Worksheets(1).Select
N = Worksheets(1).Range("A1").End(xlToRight).Column
For Each oWS In Worksheets
oWS.Select
With oWS.Range(oWS.Cells(1, 1), oWS.Cells(1, N))
.Interior.ColorIndex = 15
.Font.Bold = True
End With
With oWS.PageSetup
.PrintTitleRows = "$1:$1"
.LeftHeader = "Printed: &D"
.CenterHeader = "Report for: &A"
.RightHeader = "Page &P of &N"
.LeftMargin = 36
.RightMargin = 36
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
oWS.Cells.EntireColumn.AutoFit
oWS.Range("A2").Select
ActiveWindow.FreezePanes = True
Next oWS
Worksheets(1).Activate
Application.ScreenUpdating = True
End Sub
--
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware
(Extras for Excel add-in: convenience built-in)




"GS" <[email protected]>
wrote in message
news:[email protected]...

 

[Jim Cone]

Correction...
Actually my message was directed to Chutney not GS.
Jim Cone

 

[Chutney]

GS and Jim,

Thank you for your replies. I incorporated your suggestions but the
time required to run the macro did not change: 7 seconds per worksheet
= 7 minutes for 60 worksheets! The issue, as GS stated, is the "With
oWS.PageSetup". Without that loop, the macro runs virtually
instantaneously.

I would love to know why it takes so long to run the page settings via
VB. In the meantime, it appears that I will have to do the page
settings manually if I don't want to tie up my computer for extended
periods.

 

[GS]

It happens that Chutney formulated :

I would love to know why it takes so long to run the page settings via
VB. In the meantime, it appears that I will have to do the page
settings manually if I don't want to tie up my computer for extended
periods.

That's what I suggested! Fact is, VBa can do nothing as fast or
efficient as can Excel's built-in functions. It will still take a while
to do 60 sheets (grouped), but nowhere near as long and so is why I put
both processes into separate procedures.<g>

 

[Bob Flanagan]

It happens that Chutney formulated :


That's what I suggested! Fact is, VBa can do nothing as fast or
efficient as can Excel's built-in functions. It will still take a while
to do 60 sheets (grouped), but nowhere near as long and so is why I put
both processes into separate procedures.<g>

--
Garry

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

One of the ways to make page setup commands run faster, is to first
check the property to be set, and only set it if it needs to be set.
You will get speed increases of 10-20X. For example:

If .FitToPagesWide <> 1 then .FitToPagesWide = 1

If the above is true, it is set. If it not true, it is set to what you
want, and there is no need to set again.

Robert Flanagan
Add-ins.com LLC
144 Dewberry Drive
Hockessin, Delaware, U.S. 19707

Phone: 302-234-9857, fax 302-234-9859
http://www.add-ins.com
Productivity add-ins and downloadable books on VB macros for Excel

 

[GS]

Bob Flanagan presented the following explanation :

One of the ways to make page setup commands run faster, is to first
check the property to be set, and only set it if it needs to be set.
You will get speed increases of 10-20X. For example:

If .FitToPagesWide <> 1 then .FitToPagesWide = 1

If the above is true, it is set. If it not true, it is set to what you
want, and there is no need to set again.

Robert Flanagan
Add-ins.com LLC
144 Dewberry Drive
Hockessin, Delaware, U.S. 19707

Phone: 302-234-9857, fax 302-234-9859
http://www.add-ins.com
Productivity add-ins and downloadable books on VB macros for Excel

That sounds like a good idea! One might think that processing all the
IF's for each property would slow things down considerably. Fact is,
some of the pagesetup props take longer (individually) to process than
evaluating all the IF's<IMO>!

 

[Chutney]

Garry,

Thanks for yours. I realize that you suggested separating the macros
and, indeed, I tested the macros both ways. The end result is that it
takes the same 7 seconds per worksheet to format the page settings
whether they are done as a loop within the larger macro or as a
separate process.

It may be that VBa is not particularly efficient but so far as I have
found it is only the page setting that is so exceptionally slow. I can
literally set the page settings on one worksheet faster by hand than
the macro can. That is extraordinary!. There is no other VBa operation
that I have found that is slower by computer than by hand!

Regards,
Rick

 

[Chutney]

Bob,

Thanks for your suggestion. I have already stripped the page settings
to just those that I must use. I had not tried using IF statements and
that is an interesting suggestion for future reference. However, in
this case the macro is making changes to the defaults in a new
workbook so, unfortunately, the IF statements would simply check what
is already known.

Regards,
Rick

 

[GS]

Chutney formulated on Monday :

Garry,

Thanks for yours. I realize that you suggested separating the macros
and, indeed, I tested the macros both ways. The end result is that it
takes the same 7 seconds per worksheet to format the page settings
whether they are done as a loop within the larger macro or as a
separate process.

I'm aware that there's no time dif running the pagesetup code within
the proc OR from a separate proc. I only separated them so you would
only have a single line to comment out if you chose to do page setup
manually.

It may be that VBa is not particularly efficient but so far as I have
found it is only the page setting that is so exceptionally slow. I can
literally set the page settings on one worksheet faster by hand than
the macro can. That is extraordinary!. There is no other VBa operation
that I have found that is slower by computer than by hand!

Yes, I would tend to agree. Keep in mind, though, that in most cases
where you're trying to do built-in functions with VBa instead of using
Excel's version, the built-in procs always outperform VBa's.

 

[Jim Cone]

Turn off the display of page breaks on each sheet before changing pagesetup.
You should see a significant difference.
....
oWS.Select
oWs.DisplayPageBreaks = False
....
Also, xl4 macro code runs pagesetup code faster, not a whole lot faster, but faster.
You will need some determination to implement it. John McGimpsey, however, has simplified it
somewhat...
http://www.mcgimpsey.com/excel/udfs/pagesetup.html
--
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware
(Special Print add-in: long columns printed side by side)




"Chutney" <[email protected]>
wrote in message
GS and Jim,

Thank you for your replies. I incorporated your suggestions but the
time required to run the macro did not change: 7 seconds per worksheet
= 7 minutes for 60 worksheets! The issue, as GS stated, is the "With
oWS.PageSetup". Without that loop, the macro runs virtually
instantaneously.

I would love to know why it takes so long to run the page settings via
VB. In the meantime, it appears that I will have to do the page
settings manually if I don't want to tie up my computer for extended
periods.

 

[GS]

After serious thinking Jim Cone wrote :

Turn off the display of page breaks on each sheet before changing pagesetup.
You should see a significant difference.
...
oWS.Select
oWs.DisplayPageBreaks = False
...
Also, xl4 macro code runs pagesetup code faster, not a whole lot faster, but
faster.
You will need some determination to implement it. John McGimpsey, however,
has simplified it somewhat...

Thank you, Jim! That's really great. -Much appreciated...

 

[GS]

Jim Cone wrote :

Turn off the display of page breaks on each sheet before changing pagesetup.
You should see a significant difference.

Tried this with OP's settings and it took 11 secs longer than

...
oWS.Select
oWs.DisplayPageBreaks = False
...
Also, xl4 macro code runs pagesetup code faster, not a whole lot faster, but
faster.
You will need some determination to implement it. John McGimpsey, however,
has simplified it somewhat...
http://www.mcgimpsey.com/excel/udfs/pagesetup.html

This requires a different approach as the settings for this OP's
scenario can't be used 'as is'. It works fine as long as you don't have
the code for inserting auto text. Where can I find more detailed info
on using this XL4 function? (Link to John Green's post not working)

Thanks, Jim...

 

[GS]

Jim,
I found some stuff online. Seems that the XL4M function needs to still
be extended to include current PageSetup features[a]. Not a problem to
do since most of these go fairly quick.

[a] In this OP's scenario...

PrintTitleRows,FitToPagesTall,FitToPagesWide

Otherwise, John's macro is definitely way faster!

 

[Jim Cone]

GS,
I haven't written any xl4 PageSetup code in a while.
I have one hundred lines of code in my 'Extras for Excel' commercial add-in devoted to this stuff.
I don't understand most of it now and have an unpleasant recollection of learning to use it.
Memory tells me to use variables for your data and many, many quote marks: ""
(if it doesn't work, add more quote marks)
It would also be helpful to have a copy of the xl4 function reference (1992).
The following is from my code library...
'---
John Green ([email protected])
public.excel.programming - 01/22/2001
About PageSetup..

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.

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 01/23/2001
Here are your macros followed by the Excel 4 equivalents:

Sub test1()
With ActiveSheet.PageSetup
.CenterHorizontally = True
.PaperSize = xlPaperLetter
End With
End Sub

Sub PS4_1()
h_cntr = True
paper_size = 1
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

Sub test2()
With ActiveSheet.PageSetup
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.CenterHorizontally = True
.Orientation = xlLandscape
End With
End Sub

Sub PS4_2()
Top = 0.79
bot = 0.79
h_cntr = True
orient = 2
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
--
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware
(Special Print add-in: long columns printed side by side)

 

[GS]

Jim,
Thanks! I found the same stuff online AND I also have XLMACRO.CHM from
MSO v8.

I managed to get the quotes issue worked out and have this OP's
scenario working very fast now. I'm using McGimpsey's version of John
Green's macro. Using PageSetup the process took just over 2 mins. Using
XL4M it took 21 secs to do same work!

 

[GS]

Got it down to 13 secs now, using grouping with XL4Macro. Time to post
the code...

 

[GS]

I've been able to get this down to under 5 secs per sheet. Maybe
someone get get it working better but at least it's all automated now.
Here's the code (now uses 4 procs)...

Sub FormatWorksheets()
Dim lNumCols As Long, wks As Variant

With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual
End With '//Application
For Each wks In ActiveWorkbook.Worksheets
Application.StatusBar = "Formatting " & wks.Name
With wks
.Activate
With .Cells(1, 1)
lNumCols = .End(xlToRight).Column
With .Resize(1, lNumCols)
.Interior.ColorIndex = 15: .Font.Bold = True
.EntireColumn.AutoFit
End With '//.Resize(1, lNumCols)
.Offset(1).Activate
End With '//.Cells(1, 1)
ActiveWindow.FreezePanes = True
End With '//wks
Next
Application.StatusBar = "": DoPageSetup
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With '//Application
End Sub 'FormatWorksheets()

Sub DoPageSetup()
Dim wks As Variant

'Do these settings while sheets are grouped
GroupSheets "", False
PageSetupXL4M LeftHead:="Printed: &D", _
CenterHead:="Report for: &A", _
RightHead:="Page &P of &N", _
LeftMarginInches:="0.5", _
RightMarginInches:="0.5", _
Orientation:=CStr(xlLandscape)
Sheets(1).Select

'Properties not accessed via XL4Macro
For Each wks In ActiveWorkbook.Sheets
With wks.PageSetup
.PrintTitleRows = "$1:$1"
'Must set 'Scale' = False just before setting 'FitToPages'
.Zoom = False: .FitToPagesWide = 1: .FitToPagesTall = 100
End With '//wks.PageSetup
Next '//wks
End Sub 'DoPageSetup()

' John McGimpsey's adaptation of a John Green macro
Public Sub PageSetupXL4M(Optional LeftHead As String, _
Optional CenterHead As String, Optional RightHead As String, _
Optional LeftFoot As String, Optional CenterFoot As String, _
Optional RightFoot As String, Optional LeftMarginInches As String, _
Optional RightMarginInches As String, Optional TopMarginInches As
String, _
Optional BottomMarginInches As String, Optional HeaderMarginInches As
String, _
Optional FooterMarginInches As String, Optional PrintHeadings As
String, _
Optional PrintGridlines As String, Optional PrintComments As String,
_
Optional PrintQuality As String, Optional CenterHorizontally As
String, _
Optional CenterVertically As String, Optional Orientation As String,
_
Optional Draft As String, Optional PaperSize As String, _
Optional FirstPageNumber As String, Optional Order As String, _
Optional BlackAndWhite As String, Optional Zoom As String)

Const c As String = ","
Dim pgSetup As String, head As String, foot As String

If LeftHead <> "" Then head = "&L" & LeftHead
If CenterHead <> "" Then head = head & "&C" & CenterHead
If RightHead <> "" Then head = head & "&R" & RightHead
If Not head = "" Then head = """" & head & """"
If LeftFoot <> "" Then foot = "&L" & LeftFoot
If CenterFoot <> "" Then foot = foot & "&C" & CenterFoot
If RightFoot <> "" Then foot = foot & "&R" & RightFoot
If Not foot = "" Then foot = """" & foot & """"

pgSetup = "PAGE.SETUP(" & head & c & foot & c _
& LeftMarginInches & c & RightMarginInches & c _
& TopMarginInches & c & BottomMarginInches & c _
& PrintHeadings & c & PrintGridlines & c _
& CenterHorizontally & c & CenterVertically & c _
& Orientation & c & PaperSize & c & Zoom & c _
& FirstPageNumber & c & Order & c & BlackAndWhite & c _
& PrintQuality & c & HeaderMarginInches & c _
& FooterMarginInches & c & PrintComments & c & Draft & ")"
Application.ExecuteExcel4Macro pgSetup
End Sub 'PageSetupXL4M()

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GroupSheets()
' This procedure requires only the necessary amount of coding be used
' in the Caller. By default, it requires passing only the first arg.
' Use Example: GroupSheets "Sheet1,Sheet3"
' creates a group of only those sheets.
' To group all sheets in a workbook except those sheets:
' GroupSheets "Sheet1,Sheet3", False
' To group all sheets in a workbook pass an empty string:
' GroupSheets "", False
' You can pass the Wkb arg to specify any open workbook.
' (The Wkb doesn't need to be active for this purpose)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub GroupSheets(sSheetnames As String, _
Optional bInGroup As Boolean = True, _
Optional Wkb As Workbook)
' Groups sheets in Wkb based on whether Sheetnames
' are to be included or excluded in the grouping.
' Arg1 is a comma delimited string. (ie: "Sheet1,Sheet3")

Dim Shts() As String, sz As String
Dim i As Integer, wks As Worksheet, bNameIsIn As Boolean

If Wkb Is Nothing Then Set Wkb = ActiveWorkbook
For Each wks In Wkb.Worksheets
bNameIsIn = (InStr(sSheetnames, wks.Name) > 0)
If bInGroup And bNameIsIn Then sz = wks.Name Else sz = wks.Name
If Not sz = "" Then '//build the array
ReDim Preserve Shts(0 To i): Shts(i) = sz: i = i + 1
End If
Next
ActiveWorkbook.Worksheets(Shts).Select
End Sub

Enjoy!

 

[Clif McIrvin]

I've been able to get this down to under 5 secs per sheet. Maybe
someone get get it working better but at least it's all automated now.
Here's the code (now uses 4 procs)...

<...>

I just today stumbled across this new-to-2010 property:

Application.PrintCommunication Property
Specifies whether communication with the printer is turned on. Boolean
Read/write
Version Added: Excel 2010

Set the PrintCommunication property to False to speed up the execution
of code that sets PageSetup properties. Set the PrintCommunication
property to True after setting properties to commit all cached PageSetup
commands.