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