born2program
Technical User
I have created a macro that formats a worksheet for the users. It runs fine in Excel 2003 and takes about 8 seconds. However when I run it in Excel 2007 it will run but takes about 2.5 minutes. Is there something I can do to make this run faster in Excel 2007? I am setting the calculate mode to manual and screen updating to false, but don't know of anything else to do. Any help appreciated.
Code:
Sub mcrFormatProjWorksheetExport()
'
' Name: mcrFormatProjWorksheetExport
' Created By: Spencer May
' Created On: 3/11/2011
'
' Purpose: Format the *Task Name column to auto indent
' based on the WBS column and Type column.
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'Add column for indent count
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
'Select all rows (except the header row) in new column C (indent count column)
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
'Paste the formula for indent count in all rows of new column C (indent count column)
Selection.FormulaR1C1 = _
"=IF(RC[-2]=""ta"", R[-1]C, LEN(RC[-1]) - LEN(SUBSTITUTE(RC[-1],""."","""")))"
'Select and Hide columns C (new column) and D (old Task Name) column
Columns("C:D").Select
Selection.EntireColumn.Hidden = True
'Add column for new Task Name
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
'Select all rows (except the header row) in new column E (new Task Name column)
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
'Paste the formula for the new Task Name column in all rows of new column E (new Task Name column)
Selection.FormulaR1C1 = _
"=IF(RC[-4]=""ta"", CONCATENATE(REPT("" "",RC[-2]+1),RC[-1]),CONCATENATE(REPT("" "",RC[-2]),RC[-1]))"
'Select column E and resize column width to 65
Columns("E:E").Select
Selection.ColumnWidth = 65
'Place "*Task Name" text in Header cell of new Task Name column
Range("E1").Select
ActiveCell.FormulaR1C1 = "*Task Name"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'Sizes all active rows to RowHeight 13
ActiveWorkbook.ActiveSheet.UsedRange.RowHeight = 13
'Hide the Type column
Range("A1").Select
Selection.EntireColumn.Hidden = True
'Calls the procedure to Highlight the Task and Subtask rows
Call Highlight_Tasks
'After completed place cursor back in 1st cell.
Range("B1").Select
Application.Calculation = xlCalculationAutomatic
End Sub