Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel Macro runs slow in Excel 2007 but not slow in Excel 2003 2

Status
Not open for further replies.

born2program

Technical User
Sep 18, 2006
85
US
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
 
One difference between xl2003 and xl2007 is the number of rows allowed.
I'd try to play with CurrentRegion instead of End(xlDown)

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 

Do not use the Select method. Rather reference ranges directly...
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").Insert Shift:=xlToRight
    
    'Select all rows (except the header row) in new column C (indent count column)
    Range(Range("C2"), Range("C2").End(xlDown)).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").EntireColumn.Hidden = True
    
    'Add column for new Task Name
    Columns("E:E").Insert Shift:=xlToRight
    
    'Select all rows (except the header row) in new column E (new Task Name column)
    Range(Range("E2"), Range("E2").End(xlDown)).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").ColumnWidth = 65
    
    'Place "*Task Name" text in Header cell of new Task Name column
    with Range("E1")
        .FormulaR1C1 = "*Task Name"
        .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").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


Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Thanks for your responses. I used SkipVought's suggestion and PHV's suggestion put me on the right path to using UsedRange and Intersect() it decreased runtime from 2.5 minutes to 3 seconds. I am posting the updated code below so others may reference it. Thanks again to both of you.

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").Insert Shift:=xlToRight
    
    'Select all rows (except the header row) in new column C (indent count column)
     Intersect(ActiveSheet.UsedRange.Offset(1, 0), Columns("C")).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").EntireColumn.Hidden = True
    
    'Add column for new Task Name
    'Columns("E:E").Select
    Columns("E:E").Insert Shift:=xlToRight
    
    'Select all rows (except the header row) in new column E (new Task Name column)
     Intersect(ActiveSheet.UsedRange.Offset(1, 0), Columns("E")).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").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
     Columns("A:A").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


Sub Highlight_Tasks()

'Procedure that highlights rows flagged as a Task. (Type Column = t)

Dim rnArea As Range
Dim rnCell As Range

Set rnArea = ActiveWorkbook.ActiveSheet.UsedRange

  For Each rnCell In rnArea
     With rnCell
        If .Value = "t" Then
        
            'For each line marked as a Task, highlight the whole row with light grey.
                      
            rnCell.EntireRow.Select
            Selection.Interior.ColorIndex = 15
                  
       End If
   End With
Next


End Sub
 
I also suggest that you add Application.Calculate before turning Calc to Automatic... otherwise you will see the sheet recalculate itself after events have occured. (may not be noticable on this particular sheet, but will be evident where you have several values affected by the macro... just a little graphical fluctuation as the sheet updates)


Also, something I like to do, create a TrueFalse Public Function in my sheets/module (as needed)

Public Function xAlerts (ByRef TrueFalse as Boolean)
With Application
.ScreenUpdating = TrueFalse
.DisplayAlerts = TrueFalse
If TrueFalse = True Then
.Calculate
.Calculation = xlCalculateAutomatic
ElseIf TrueFalse = False
.Calculation = xlCalculateManual
End If
End With
End Function


Now when you start a Sub/Function, xAlerts False and before the End xAlerts True

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top