optimization for formatting worksheets
 

Hi,

I have a macro that formats 30 worksheets, which takes a long time to
run and significantly slows my computer. It would be greatly
appreciated if anyone could point out which parts are causing the
delay and need to be optimized. Thanks!


Sub formatsheets()
For i = 1 To numSheets1
dFormatKeyMeasures1 sheetNames1:=sheetNames1(i - 1),
sheetTitles1:=sheetTitles1(i - 1)
Next i
End Sub

Private Function dFormatKeyMeasures1(ByVal sheetNames1 As String,
ByVal sheetTitles1 As String)

Sheets(sheetNames1).Select

'Add and format titles
ActiveSheet.Range("d1").FormulaR1C1 = "Profitability Report of
Clients"
Range("d2").FormulaR1C1 = "Key Measures by Client (" &
sheetTitles1 & ")"
Range("d3").FormulaR1C1 = "(C$ " & Period & " Information ending "
& ReportingDate & ")"
rows("1:3").Select
With Selection.Font
.Bold = True
.Name = "TimesNewRoman"
End With
rows("1:1").Select
Selection.Font.Size = 14
rows("2:3").Select
Selection.Font.Size = 12

'Format report cells
Sheets(sheetNames1).Range("A6:AG1000").Select
With Selection
.WrapText = False
.HorizontalAlignment = xlLeft
.Style = "Comma"
.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
End With
Range("H6:J1000").Select
With Selection
.NumberFormat = "#,##0.000"
End With

'Format total lines
Dim j As Integer
j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired")
If j = 1 Then
Range("D5").End(xlDown).Offset(3, 0).Select
ActiveCell.FormulaR1C1 = "Impaired Loans"
With ActiveCell
.Font.Bold = True
.HorizontalAlignment = xlLeft
End With
End If

Range("K5").End(xlDown).Offset(2, 0).Select
With Selection
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
ActiveCell.Copy
Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats

j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired") - 1
If j = 1 Then
ActiveSheet.Range("K65536").End(xlUp).Offset(-2, 0).Select
With Selection
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
ActiveCell.Copy
Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
ActiveSheet.Range("K65536").End(xlUp).Select
With Selection
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlDouble
.Borders(xlEdgeBottom).Weight = xlThick
End With
ActiveCell.Copy
Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
ElseIf j = 0 Then
ActiveSheet.Range("K65536").End(xlUp).Select
With Selection
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlDouble
.Borders(xlEdgeBottom).Weight = xlThick
End With
ActiveCell.Copy
Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
End If


'Adjust column sizes and hide irrelevant columns
Columns("A:A").Select
Columns("A:A").ColumnWidth = 10
Columns("B:B").ColumnWidth = 10
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").ColumnWidth = 55
Columns("E:E").ColumnWidth = 4
Columns("F:F").ColumnWidth = 5.5
Columns("G:G").ColumnWidth = 6
Columns("H:I").ColumnWidth = 6.5
Columns("J:J").ColumnWidth = 8.5
Columns("E:J").HorizontalAlignment = xlCenter
Columns("K:O").ColumnWidth = 14
Columns("P:Q").ColumnWidth = 13
Columns("R:R").ColumnWidth = 10.5
Columns("S:S").ColumnWidth = 8
Columns("T:T").ColumnWidth = 11.5
Columns("V:V").ColumnWidth = 13
Columns("W:W").ColumnWidth = 11.5
Columns("X:X").ColumnWidth = 8
Columns("Y:Z").ColumnWidth = 11.5
Columns("AA:AA").ColumnWidth = 8
Columns("AB:AB").ColumnWidth = 10.5
Columns("AC:AH").Select
Columns("AC:AH").EntireColumn.AutoFit
Columns("AC:AH").Hidden = True
Columns("T:U").Hidden = True

'Shade every other row for Performing
Range("A7:AH7").Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Range("a8").Select
ActiveCell.EntireRow.Insert
rows("6:7").Select
Selection.Copy
Range("a9").CurrentRegion.Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("a8").EntireRow.Delete
rows("6:7").Select
Selection.Copy

'Shade every other row for Impaired, if existing
j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired") - 1
If j = 1 Then
Range("a5").End(xlDown).Offset(5, 0).CurrentRegion.Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
End If


'Freeze Panes
rows("6:6").Select
ActiveWindow.FreezePanes = True

'Printer Settings
Range("AH65536").End(xlUp).Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$5"
.PrintArea = "C:AB"
.LeftMargin = Application.InchesToPoints(0.1)
.RightMargin = Application.InchesToPoints(0.1)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
.FitToPagesWide = 1
.FitToPagesTall = False
.Zoom = False
.PrintQuality = 600
End With

End Function

optimization for formatting worksheets
 

big macro! every time you select, you're slowing things down.
instead of

rows("1:3").Select
With Selection.Font
.Bold = True
.Name = "TimesNewRoman"
End With
rows("1:1").Select
Selection.Font.Size = 14
rows("2:3").Select
Selection.Font.Size = 12

try:

rows("1:3").Font.Bold = True
rows("1:3").Font.Name = "TimesNewRoman"
rows("1:1").Font.Size = 14
rows("2:3").Font.Size = 12

i've just replaced 9 VBA commands with 4 - less than half. doing
things like that will definitely speed up your code. but as i said,
it is a large code & may always take quite a bit of time.
hope this helps
:)
susan




On Nov 12, 3:32*pm, mtzc wrote:
Hi,

I have a macro that formats 30 worksheets, which takes a long time to
run and significantly slows my computer. It would be greatly
appreciated if anyone could point out which parts are causing the
delay and need to be optimized. Thanks!

Sub formatsheets()
For i = 1 To numSheets1
* * * * dFormatKeyMeasures1 sheetNames1:=sheetNames1(i - 1),
sheetTitles1:=sheetTitles1(i - 1)
* * Next i
End Sub

Private Function dFormatKeyMeasures1(ByVal sheetNames1 As String,
ByVal sheetTitles1 As String)

Sheets(sheetNames1).Select

'Add and format titles
* * ActiveSheet.Range("d1").FormulaR1C1 = "Profitability Report of
Clients"
* * Range("d2").FormulaR1C1 = "Key Measures by Client (" &
sheetTitles1 & ")"
* * Range("d3").FormulaR1C1 = "(C$ " & Period & " Information ending "
& ReportingDate & ")"
* * rows("1:3").Select
* * With Selection.Font
* * * * .Bold = True
* * * * .Name = "TimesNewRoman"
* * End With
* * rows("1:1").Select
* * Selection.Font.Size = 14
* * rows("2:3").Select
* * Selection.Font.Size = 12

'Format report cells
* * Sheets(sheetNames1).Range("A6:AG1000").Select
* * With Selection
* * * * .WrapText = False
* * * * .HorizontalAlignment = xlLeft
* * * * .Style = "Comma"
* * * * .NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
* * End With
* * Range("H6:J1000").Select
* * With Selection
* * * * .NumberFormat = "#,##0.000"
* * End With

*'Format total lines
* * * * Dim j As Integer
* * * * j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired")
* * * * If j = 1 Then
* * * * Range("D5").End(xlDown).Offset(3, 0).Select
* * * * ActiveCell.FormulaR1C1 = "Impaired Loans"
* * * * With ActiveCell
* * * * * * .Font.Bold = True
* * * * * * .HorizontalAlignment = xlLeft
* * * * End With
* * * * End If

* * * * Range("K5").End(xlDown).Offset(2, 0).Select
* * * * With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * End With
* * * * ActiveCell.Copy
* * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats

* * * * j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired") - 1
* * * * * * If j = 1 Then
* * * * * * ActiveSheet.Range("K65536").End(xlUp).Offset(-2, 0).Select
* * * * * * *With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * * * End With
* * * * * * ActiveCell.Copy
* * * * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
* * * * * * ActiveSheet.Range("K65536").End(xlUp).Select
* * * * * * *With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlDouble
* * * * * * .Borders(xlEdgeBottom).Weight = xlThick
* * * * * * End With
* * * * * * ActiveCell.Copy
* * * * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
* * * * * * ElseIf j = 0 Then
* * * * * * ActiveSheet.Range("K65536").End(xlUp).Select
* * * * * * *With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlDouble
* * * * * * .Borders(xlEdgeBottom).Weight = xlThick
* * * * * * End With
* * * * * * ActiveCell.Copy
* * * * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
* * * * * * End If

* * 'Adjust column sizes and hide irrelevant columns
* * Columns("A:A").Select
* * Columns("A:A").ColumnWidth = 10
* * Columns("B:B").ColumnWidth = 10
* * Columns("C:C").EntireColumn.AutoFit
* * Columns("D:D").ColumnWidth = 55
* * Columns("E:E").ColumnWidth = 4
* * Columns("F:F").ColumnWidth = 5.5
* * Columns("G:G").ColumnWidth = 6
* * Columns("H:I").ColumnWidth = 6.5
* * Columns("J:J").ColumnWidth = 8.5
* * Columns("E:J").HorizontalAlignment = xlCenter
* * Columns("K:O").ColumnWidth = 14
* * Columns("P:Q").ColumnWidth = 13
* * Columns("R:R").ColumnWidth = 10.5
* * Columns("S:S").ColumnWidth = 8
* * Columns("T:T").ColumnWidth = 11.5
* * Columns("V:V").ColumnWidth = 13
* * Columns("W:W").ColumnWidth = 11.5
* * Columns("X:X").ColumnWidth = 8
* * Columns("Y:Z").ColumnWidth = 11.5
* * Columns("AA:AA").ColumnWidth = 8
* * Columns("AB:AB").ColumnWidth = 10.5
* * Columns("AC:AH").Select
* * Columns("AC:AH").EntireColumn.AutoFit
* * Columns("AC:AH").Hidden = True
* * Columns("T:U").Hidden = True

* * 'Shade every other row for Performing
* * Range("A7:AH7").Select
* * With Selection.Interior
* * * * .ColorIndex = 15
* * * * .Pattern = xlSolid
* * End With
* * Range("a8").Select
* * ActiveCell.EntireRow.Insert
* * rows("6:7").Select
* * Selection.Copy
* * Range("a9").CurrentRegion.Select
* * Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
* * * * False, Transpose:=False
* * Range("a8").EntireRow.Delete
* * rows("6:7").Select
* * Selection.Copy

* * 'Shade every other row for Impaired, if existing
* * * * j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired") - 1
* * * * If j = 1 Then
* * * * Range("a5").End(xlDown).Offset(5, 0).CurrentRegion.Select
* * * * Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
* * * * False, Transpose:=False
* * End If

* * 'Freeze Panes
* * rows("6:6").Select
* * ActiveWindow.FreezePanes = True

* * 'Printer Settings
* * Range("AH65536").End(xlUp).Select
* * With ActiveSheet.PageSetup
* * * * .PrintTitleRows = "$1:$5"
* * * * .PrintArea = "C:AB"
* * * * .LeftMargin = Application.InchesToPoints(0.1)
* * * * .RightMargin = Application.InchesToPoints(0.1)
* * * * .TopMargin = Application.InchesToPoints(0.5)
* * * * .BottomMargin = Application.InchesToPoints(0.5)
* * * * .Orientation = xlLandscape
* * * * .PaperSize = xlPaperLegal
* * * * .FitToPagesWide = 1
* * * * .FitToPagesTall = False
* * * * .Zoom = False
* * * * .PrintQuality = 600
* * End With

End Function

optimization for formatting worksheets
 

another thought - put

application.screenupdating=false

at the top of your code, and then turn it back to true at the end of
your code.
susan


On Nov 12, 3:45*pm, Susan wrote:
big macro! *every time you select, you're slowing things down.
instead of

* * rows("1:3").Select
* * With Selection.Font
* * * * .Bold = True
* * * * .Name = "TimesNewRoman"
* * End With
* * rows("1:1").Select
* * Selection.Font.Size = 14
* * rows("2:3").Select
* * Selection.Font.Size = 12

try:

rows("1:3").Font.Bold = True
rows("1:3").Font.Name = "TimesNewRoman"
rows("1:1").Font.Size = 14
rows("2:3").Font.Size = 12

i've just replaced 9 VBA commands with 4 - less than half. *doing
things like that will definitely speed up your code. *but as i said,
it is a large code & may always take quite a bit of time.
hope this helps
:)
susan

On Nov 12, 3:32*pm, mtzc wrote:



Hi,

I have a macro that formats 30 worksheets, which takes a long time to
run and significantly slows my computer. It would be greatly
appreciated if anyone could point out which parts are causing the
delay and need to be optimized. Thanks!

Sub formatsheets()
For i = 1 To numSheets1
* * * * dFormatKeyMeasures1 sheetNames1:=sheetNames1(i - 1),
sheetTitles1:=sheetTitles1(i - 1)
* * Next i
End Sub

Private Function dFormatKeyMeasures1(ByVal sheetNames1 As String,
ByVal sheetTitles1 As String)

Sheets(sheetNames1).Select

'Add and format titles
* * ActiveSheet.Range("d1").FormulaR1C1 = "Profitability Report of
Clients"
* * Range("d2").FormulaR1C1 = "Key Measures by Client (" &
sheetTitles1 & ")"
* * Range("d3").FormulaR1C1 = "(C$ " & Period & " Information ending "
& ReportingDate & ")"
* * rows("1:3").Select
* * With Selection.Font
* * * * .Bold = True
* * * * .Name = "TimesNewRoman"
* * End With
* * rows("1:1").Select
* * Selection.Font.Size = 14
* * rows("2:3").Select
* * Selection.Font.Size = 12

'Format report cells
* * Sheets(sheetNames1).Range("A6:AG1000").Select
* * With Selection
* * * * .WrapText = False
* * * * .HorizontalAlignment = xlLeft
* * * * .Style = "Comma"
* * * * .NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
* * End With
* * Range("H6:J1000").Select
* * With Selection
* * * * .NumberFormat = "#,##0.000"
* * End With

*'Format total lines
* * * * Dim j As Integer
* * * * j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired")
* * * * If j = 1 Then
* * * * Range("D5").End(xlDown).Offset(3, 0).Select
* * * * ActiveCell.FormulaR1C1 = "Impaired Loans"
* * * * With ActiveCell
* * * * * * .Font.Bold = True
* * * * * * .HorizontalAlignment = xlLeft
* * * * End With
* * * * End If

* * * * Range("K5").End(xlDown).Offset(2, 0).Select
* * * * With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * End With
* * * * ActiveCell.Copy
* * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats

* * * * j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired") - 1
* * * * * * If j = 1 Then
* * * * * * ActiveSheet.Range("K65536").End(xlUp).Offset(-2, 0).Select
* * * * * * *With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * * * End With
* * * * * * ActiveCell.Copy
* * * * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
* * * * * * ActiveSheet.Range("K65536").End(xlUp).Select
* * * * * * *With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlDouble
* * * * * * .Borders(xlEdgeBottom).Weight = xlThick
* * * * * * End With
* * * * * * ActiveCell.Copy
* * * * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
* * * * * * ElseIf j = 0 Then
* * * * * * ActiveSheet.Range("K65536").End(xlUp).Select
* * * * * * *With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlDouble
* * * * * * .Borders(xlEdgeBottom).Weight = xlThick
* * * * * * End With
* * * * * * ActiveCell.Copy
* * * * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
* * * * * * End If

* * 'Adjust column sizes and hide irrelevant columns
* * Columns("A:A").Select
* * Columns("A:A").ColumnWidth = 10
* * Columns("B:B").ColumnWidth = 10
* * Columns("C:C").EntireColumn.AutoFit
* * Columns("D:D").ColumnWidth = 55
* * Columns("E:E").ColumnWidth = 4
* * Columns("F:F").ColumnWidth = 5.5
* * Columns("G:G").ColumnWidth = 6
* * Columns("H:I").ColumnWidth = 6.5
* * Columns("J:J").ColumnWidth = 8.5
* * Columns("E:J").HorizontalAlignment = xlCenter
* * Columns("K:O").ColumnWidth = 14
* * Columns("P:Q").ColumnWidth = 13
* * Columns("R:R").ColumnWidth = 10.5
* * Columns("S:S").ColumnWidth = 8
* * Columns("T:T").ColumnWidth = 11.5
* * Columns("V:V").ColumnWidth = 13
* * Columns("W:W").ColumnWidth = 11.5
* * Columns("X:X").ColumnWidth = 8
* * Columns("Y:Z").ColumnWidth = 11.5
* * Columns("AA:AA").ColumnWidth = 8
* * Columns("AB:AB").ColumnWidth = 10.5
* * Columns("AC:AH").Select
* * Columns("AC:AH").EntireColumn.AutoFit
* * Columns("AC:AH").Hidden = True
* * Columns("T:U").Hidden = True

* * 'Shade every other row for Performing
* * Range("A7:AH7").Select
* * With Selection.Interior
* * * * .ColorIndex = 15
* * * * .Pattern = xlSolid
* * End With
* * Range("a8").Select
* * ActiveCell.EntireRow.Insert
* * rows("6:7").Select
* * Selection.Copy
* * Range("a9").CurrentRegion.Select
* * Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
* * * * False, Transpose:=False
* * Range("a8").EntireRow.Delete
* * rows("6:7").Select
* * Selection.Copy

* * 'Shade every other row for Impaired, if existing
* * * * j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired") - 1
* * * * If j = 1 Then
* * * * Range("a5").End(xlDown).Offset(5, 0).CurrentRegion.Select
* * * * Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
* * * * False, Transpose:=False
* * End If

* * 'Freeze Panes
* * rows("6:6").Select
* * ActiveWindow.FreezePanes = True

* * 'Printer Settings
* * Range("AH65536").End(xlUp).Select
* * With ActiveSheet.PageSetup
* * * * .PrintTitleRows = "$1:$5"
* * * * .PrintArea = "C:AB"
* * * * .LeftMargin = Application.InchesToPoints(0.1)
* * * * .RightMargin = Application.InchesToPoints(0.1)
* * * * .TopMargin = Application.InchesToPoints(0.5)
* * * * .BottomMargin = Application.InchesToPoints(0.5)
* * * * .Orientation = xlLandscape
* * * * .PaperSize = xlPaperLegal
* * * * .FitToPagesWide = 1
* * * * .FitToPagesTall = False
* * * * .Zoom = False
* * * * .PrintQuality = 600
* * End With

End Function- Hide quoted text -

- Show quoted text -

optimization for formatting worksheets
 

Hi

Besides what Susan suggest, you can turn off screenupdating, as it
will speed up your macro:

Sub formatsheets()
Application.ScreenUpdating = False
For i = 1 To numSheets1
dFormatKeyMeasures1 sheetNames1:=sheetNames1(i - 1),
sheetTitles1:=sheetTitles1(i - 1)
Next i
Application.ScreenUpdating = True
End Sub

Regards,
Per

On 12 Nov., 21:45, Susan wrote:
big macro! *every time you select, you're slowing things down.
instead of

* * rows("1:3").Select
* * With Selection.Font
* * * * .Bold = True
* * * * .Name = "TimesNewRoman"
* * End With
* * rows("1:1").Select
* * Selection.Font.Size = 14
* * rows("2:3").Select
* * Selection.Font.Size = 12

try:

rows("1:3").Font.Bold = True
rows("1:3").Font.Name = "TimesNewRoman"
rows("1:1").Font.Size = 14
rows("2:3").Font.Size = 12

i've just replaced 9 VBA commands with 4 - less than half. *doing
things like that will definitely speed up your code. *but as i said,
it is a large code & may always take quite a bit of time.
hope this helps
:)
susan

On Nov 12, 3:32*pm, mtzc wrote:



Hi,

I have a macro that formats 30 worksheets, which takes a long time to
run and significantly slows my computer. It would be greatly
appreciated if anyone could point out which parts are causing the
delay and need to be optimized. Thanks!

Sub formatsheets()
For i = 1 To numSheets1
* * * * dFormatKeyMeasures1 sheetNames1:=sheetNames1(i - 1),
sheetTitles1:=sheetTitles1(i - 1)
* * Next i
End Sub

Private Function dFormatKeyMeasures1(ByVal sheetNames1 As String,
ByVal sheetTitles1 As String)

Sheets(sheetNames1).Select

'Add and format titles
* * ActiveSheet.Range("d1").FormulaR1C1 = "Profitability Report of
Clients"
* * Range("d2").FormulaR1C1 = "Key Measures by Client (" &
sheetTitles1 & ")"
* * Range("d3").FormulaR1C1 = "(C$ " & Period & " Information ending "
& ReportingDate & ")"
* * rows("1:3").Select
* * With Selection.Font
* * * * .Bold = True
* * * * .Name = "TimesNewRoman"
* * End With
* * rows("1:1").Select
* * Selection.Font.Size = 14
* * rows("2:3").Select
* * Selection.Font.Size = 12

'Format report cells
* * Sheets(sheetNames1).Range("A6:AG1000").Select
* * With Selection
* * * * .WrapText = False
* * * * .HorizontalAlignment = xlLeft
* * * * .Style = "Comma"
* * * * .NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
* * End With
* * Range("H6:J1000").Select
* * With Selection
* * * * .NumberFormat = "#,##0.000"
* * End With

*'Format total lines
* * * * Dim j As Integer
* * * * j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired")
* * * * If j = 1 Then
* * * * Range("D5").End(xlDown).Offset(3, 0).Select
* * * * ActiveCell.FormulaR1C1 = "Impaired Loans"
* * * * With ActiveCell
* * * * * * .Font.Bold = True
* * * * * * .HorizontalAlignment = xlLeft
* * * * End With
* * * * End If

* * * * Range("K5").End(xlDown).Offset(2, 0).Select
* * * * With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * End With
* * * * ActiveCell.Copy
* * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats

* * * * j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired") - 1
* * * * * * If j = 1 Then
* * * * * * ActiveSheet.Range("K65536").End(xlUp).Offset(-2, 0).Select
* * * * * * *With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * * * End With
* * * * * * ActiveCell.Copy
* * * * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
* * * * * * ActiveSheet.Range("K65536").End(xlUp).Select
* * * * * * *With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlDouble
* * * * * * .Borders(xlEdgeBottom).Weight = xlThick
* * * * * * End With
* * * * * * ActiveCell.Copy
* * * * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
* * * * * * ElseIf j = 0 Then
* * * * * * ActiveSheet.Range("K65536").End(xlUp).Select
* * * * * * *With Selection
* * * * * * .Borders(xlEdgeTop).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlContinuous
* * * * * * .Borders(xlEdgeBottom).LineStyle = xlDouble
* * * * * * .Borders(xlEdgeBottom).Weight = xlThick
* * * * * * End With
* * * * * * ActiveCell.Copy
* * * * * * Range(ActiveCell, Cells(ActiveCell.Row, 33)).PasteSpecial
xlPasteFormats
* * * * * * End If

* * 'Adjust column sizes and hide irrelevant columns
* * Columns("A:A").Select
* * Columns("A:A").ColumnWidth = 10
* * Columns("B:B").ColumnWidth = 10
* * Columns("C:C").EntireColumn.AutoFit
* * Columns("D:D").ColumnWidth = 55
* * Columns("E:E").ColumnWidth = 4
* * Columns("F:F").ColumnWidth = 5.5
* * Columns("G:G").ColumnWidth = 6
* * Columns("H:I").ColumnWidth = 6.5
* * Columns("J:J").ColumnWidth = 8.5
* * Columns("E:J").HorizontalAlignment = xlCenter
* * Columns("K:O").ColumnWidth = 14
* * Columns("P:Q").ColumnWidth = 13
* * Columns("R:R").ColumnWidth = 10.5
* * Columns("S:S").ColumnWidth = 8
* * Columns("T:T").ColumnWidth = 11.5
* * Columns("V:V").ColumnWidth = 13
* * Columns("W:W").ColumnWidth = 11.5
* * Columns("X:X").ColumnWidth = 8
* * Columns("Y:Z").ColumnWidth = 11.5
* * Columns("AA:AA").ColumnWidth = 8
* * Columns("AB:AB").ColumnWidth = 10.5
* * Columns("AC:AH").Select
* * Columns("AC:AH").EntireColumn.AutoFit
* * Columns("AC:AH").Hidden = True
* * Columns("T:U").Hidden = True

* * 'Shade every other row for Performing
* * Range("A7:AH7").Select
* * With Selection.Interior
* * * * .ColorIndex = 15
* * * * .Pattern = xlSolid
* * End With
* * Range("a8").Select
* * ActiveCell.EntireRow.Insert
* * rows("6:7").Select
* * Selection.Copy
* * Range("a9").CurrentRegion.Select
* * Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
* * * * False, Transpose:=False
* * Range("a8").EntireRow.Delete
* * rows("6:7").Select
* * Selection.Copy

* * 'Shade every other row for Impaired, if existing
* * * * j = WorksheetFunction.CountIf(Sheets(sheetNames1).Colu mns(1),
"zimpaired") - 1
* * * * If j = 1 Then
* * * * Range("a5").End(xlDown).Offset(5, 0).CurrentRegion.Select
* * * * Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
* * * * False, Transpose:=False
* * End If

* * 'Freeze Panes
* * rows("6:6").Select
* * ActiveWindow.FreezePanes = True

* * 'Printer Settings
* * Range("AH65536").End(xlUp).Select
* * With ActiveSheet.PageSetup
* * * * .PrintTitleRows = "$1:$5"
* * * * .PrintArea = "C:AB"
* * * * .LeftMargin = Application.InchesToPoints(0.1)
* * * * .RightMargin = Application.InchesToPoints(0.1)
* * * * .TopMargin = Application.InchesToPoints(0.5)
* * * * .BottomMargin = Application.InchesToPoints(0.5)
* * * * .Orientation = xlLandscape
* * * * .PaperSize = xlPaperLegal
* * * * .FitToPagesWide = 1
* * * * .FitToPagesTall = False
* * * * .Zoom = False
* * * * .PrintQuality = 600
* * End With

End Function- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -

optimization for formatting worksheets
 

Thanks so much Susan and Per. I will give these a try. All the best!