How to get VBA to work on Multiple worksheets in excel!?

[Retro69]

Hi there,

Im trying to get my macro to setup each page in a workbook (with 45 worksheets) to be formatted in a certain way. When i am trying to run the code it completes the macro but when restarting excel it gives me an "out of memory" error. Is there a way of clearing the memory after the program runs so that im able to use the formatted worksheets and restart excel without these issues happening. Any help or example code for this would be a great help.

Thanks in advance.

Quenton.

 

[RobBroekhuis]

Post the code that's causing the problem.
Rob

 

[Retro69]

Here is the code.

Sub PrintSetUp2()

Application.ScreenUpdating = False

Dim StrCaps As String
Dim StrCaps2 As String
Dim StrCaps3 As String
Dim StrCaps4 As String
Dim StrCaps5 As String
Dim StrCaps6 As String
Dim StrCaps7 As String
Dim StrCaps8 As String

Sheets("cost centres&quot.Select
Range("B1&quot.Select
StrCaps = Selection
Range("B1&quot.Value = UCase(StrCaps)

Range("d1&quot.Select
StrCaps2 = Selection
Range("d1&quot.Value = UCase(StrCaps2)

Range("f1&quot.Select
StrCaps3 = Selection
Range("f1&quot.Value = UCase(StrCaps3)

Range("h1&quot.Select
StrCaps4 = Selection
Range("h1&quot.Value = UCase(StrCaps4)

Range("j1&quot.Select
StrCaps5 = Selection
Range("j1&quot.Value = UCase(StrCaps5)

Range("l1&quot.Select
StrCaps6 = Selection
Range("l1&quot.Value = UCase(StrCaps6)

Range("n1&quot.Select
StrCaps7 = Selection
Range("n1&quot.Value = UCase(StrCaps7)


Dim Counter2 As Integer
If Sheets("info&quot.Range("b1&quot = (StrCaps) Then _
Counter2 = Sheets("Cost Centres&quot.Range("B2&quot Else If Sheets("info&quot.Range("b1&quot = (StrCaps2) Then _
Counter2 = Sheets("Cost Centres&quot.Range("D2&quot Else If Sheets("info&quot.Range("b1&quot = (StrCaps3) Then _
Counter2 = Sheets("Cost Centres&quot.Range("F2&quot Else If Sheets("info&quot.Range("b1&quot = (StrCaps4) Then _
Counter2 = Sheets("Cost Centres&quot.Range("H2&quot Else If Sheets("info&quot.Range("b1&quot = (StrCaps5) Then _
Counter2 = Sheets("Cost Centres&quot.Range("j2&quot Else If Sheets("info&quot.Range("b1&quot = (StrCaps6) Then _
Counter2 = Sheets("Cost Centres&quot.Range("L2&quot Else If Sheets("info&quot.Range("b1&quot = (StrCaps7) Then _
Counter2 = Sheets("Cost Centres&quot.Range("N2&quot Else MsgBox "Check Service spelling"

Counter = 0
Counter2 = Counter2 + 2

If Counter2 < 25 Then

Do While Counter < Counter2
Counter = Counter + 1

SheetName = &quot;sheet&quot; & Counter

Sheets(SheetName).Select

Call PrintSetUp


SheetName = &quot;sheet&quot; & Counter

Sheets(SheetName).Select

Loop

Else

MsgBox &quot;More than 22 Cost Centres&quot;

End If


End Sub


Sub PrintSetUp()

Range(&quot;K6&quot.Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With

Range(&quot;B1&quot.Select
With ActiveSheet.PageSetup
.LeftHeader = &quot;&quot;
.CenterHeader = &quot;&quot;
.RightHeader = &quot;&quot;
.LeftFooter = &quot;&F&quot;
.CenterFooter = &quot;&quot;
.RightFooter = &quot;&D&quot;
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.196850393700787)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.196850393700787)
.FooterMargin = Application.InchesToPoints(0.15748031496063)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
'ActiveWindow.SelectedSheets.PrintPreview



End Sub

 

[RobBroekhuis]

I'm not sure what's causing your problem. In trying to understand your code, I did tidy things up a bit (see below). You can further improve on the efficiency of the code by only setting the required settings of the pagesetup, instead of all of them (which is what the macro recorder will give you every time). For instance, if the only ones you care about are the FitToPages settings, you can delete all the others. Let us know if you still have problems.
Rob

Sub PrintSetUp2()
Dim counter as integer, Counter2 As Integer
Application.ScreenUpdating = False
Sheets(&quot;cost centres&quot.Select
[B1]=ucase([B1])
[D1]=ucase([D1])
[F1]=ucase([F1])
[H1]=ucase([H1])
[J1]=ucase([J1])
[L1]=ucase([L1])
[N1]=ucase([N1])
select case Sheets(&quot;info&quot.Range(&quot;b1&quot
case [B1]: Counter2 = [B2]
case [D1]: Counter2 = [D2]
case [F1]: Counter2 = [F2]
case [H1]: Counter2 = [H2}
case [J1]: Counter2 = [J2]
case [L1]: Counter2 = [L2]
case [N1]: Counter2 = [N2]
case else: MsgBox &quot;Check Service spelling&quot;
end select
Counter = 0
Counter2 = Counter2 + 2
If Counter2 < 25 Then
Do While Counter < Counter2
Counter = Counter + 1
SheetName = &quot;sheet&quot; & Counter
Sheets(SheetName).Select
Call PrintSetUp
Loop
Else
MsgBox &quot;More than 22 Cost Centres&quot;
End If
End Sub

Sub PrintSetUp()
With range(&quot;K6&quot
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With ActiveSheet.PageSetup
.LeftFooter = &quot;&F&quot;
.RightFooter = &quot;&D&quot;
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.196850393700787)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.196850393700787)
.FooterMargin = Application.InchesToPoints(0.15748031496063)
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Sub
Rob

 

[PaulTEG]

How much memory is in the machine?

You could try saving the spreadsheet after each Worksheet is updated

HTH
;P