View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Brenda Brenda is offline
external usenet poster
 
Posts: 137
Default Slow exports from MS Project to Excel

I did find some posts on this board about Excel 2007 macros being much slower
than in 2003, so I suspect that I'm experiencing the same issue as others
even though my macro is actually running in MS Project. It sounds like the
only way anyone might be able to help is by viewing the code. Below is one
of the macros that we are using. This was written by someone else and I have
just made tweaks to it. I'm definitely not a VBA developer!

Thanks again!

Sub AllTaskstoExcel()
'===========================================
' This macro exports all project tasks to a single Excel worksheet tab.
'===========================================

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlRow As Excel.Range
Dim xlCol As Excel.Range
Dim Proj As Project
Dim T As Task
Dim ts As Tasks

Dim Asgn As Assignment
Dim ColumnCount As Integer
Dim Columns As Integer
Dim Tcount As Integer
Dim calcFinishDAte As Variant
Dim myStartDate As Date
Dim ProjName As String

If xlApp Is Nothing Then
'Start new instance
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't Find Excel, please try again.", vbCritical
End 'Stop, can't proceed without Excel
End If
Else
Set xlR = Nothing
Set xlApp = Nothing
Set xlBook = Nothing
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't Find Excel, please try again.", vbCritical
End 'Stop, can't proceed without Excel
End If
End If

Set xlBook = xlApp.Workbooks.Add

AppActivate "Microsoft Project"
xlApp.Visible = True
AppActivate "Microsoft Excel"

'Get the Project Name to be used in the Page Header
'You need to change the project name in the "GetProjectName" macro/module
ProjName = MyProjName()

Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "All Tasks for Team" ' Description for the Excel
worksheet tab
xlSheet.PageSetup.CenterHeader = "&B &14" + ProjName + "&B" ' Makes the
header you entered bold and 14 pt font size
xlSheet.PageSetup.RightMargin = 25
xlSheet.PageSetup.LeftMargin = 25
xlSheet.PageSetup.TopMargin = 50
xlSheet.PageSetup.BottomMargin = 50
xlSheet.PageSetup.HeaderMargin = 25
xlSheet.PageSetup.FooterMargin = 25
xlSheet.PageSetup.RightFooter = "&09 Page &P of &N" ' Sets the right
footer to 9 pt font size and to say "Page x of x"
xlSheet.PageSetup.LeftFooter = "&09 &D &T" ' Sets the left footer to 9
pt font size and the current date/time
xlSheet.PageSetup.Orientation = xlLandscape ' Sets the Excel doc to
landscape
xlSheet.PageSetup.PaperSize = xlPaperLegal ' Sets the paper size to legal
xlSheet.PageSetup.Zoom = False ' This needs to be set to false for the
following setting to work properly
xlSheet.PageSetup.FitToPagesWide = 1 ' Sets the Excel doc to always
fit to one page wide
xlSheet.PageSetup.FitToPagesTall = 100 ' Sets the Excel doc to go up to
100 pages in length, if you think you will have a longer doc, change this #
xlSheet.PageSetup.PrintTitleRows = xlSheet.Rows(1).Address ' Repeats
the column headings on every page
xlSheet.Cells.VerticalAlignment = xlVAlignTop ' Aligns the text in the
cells to the top of the cell, this is good for when some columns wrap
xlSheet.PageSetup.PrintGridlines = True ' Prints gridlines, this is
helpful because borders will not fill in on blank resources cells
xlApp.ActiveWindow.GridlineColorIndex = 1 ' Sets the gridline color to a
dark color

Do While xlBook.Worksheets.Count 1 ' This deletes extra blank tabs
xlBook.Worksheets(2).Delete
Loop

'count columns needed
ColumnCount = 1

'Set Range to write to first cell
Set xlRow = xlApp.ActiveCell

Set xlCol = xlRow.Offset(0, 0)
xlCol = "ID"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 4
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "SubTeam"
xlCol.Font.Bold = True
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "% Comp"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 6
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "Activity"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 50
xlCol.WrapText = True
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "Duration"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 5
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "Start Date"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 12
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "Finish Date"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 12
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "Predecessors"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 7
xlCol.WrapText = True
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "Act Start"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 10
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "Act Finish"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 10
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "Comments"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 50
xlCol.WrapText = True
xlCol.VerticalAlignment = xlVAlignBottom

Set xlCol = xlCol.Offset(0, 1)
xlCol = "Resources"
xlCol.Font.Bold = True
xlCol.ColumnWidth = 13
xlCol.VerticalAlignment = xlVAlignBottom

Tcount = 0

For Each T In ActiveProject.Tasks

myStartDate = DateFormat(T.Start, pjDate_mm_dd_yyyy)

'Set the fields
'Task ID
Set xlRow = xlRow.Offset(1, 0)
Set xlCol = xlRow.Offset(0, 0)

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If
xlCol = T.ID

'Subteam
Set xlCol = xlCol.Offset(0, 1)

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If
xlSheet.Columns("B").AutoFit ' Sizes column to fit longest
subteam name (or column heading if it is longest)
xlCol = T.Text30

'% Complete
Set xlCol = xlCol.Offset(0, 1)
xlCol = FormatPercent(T.PercentComplete / 100, 0)

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If

'Task Name
Set xlCol = xlCol.Offset(0, 1)
xlCol = T.Name
xlCol.WrapText = 1

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If
xlCol.IndentLevel = T.OutlineLevel

'Duration
Set xlCol = xlCol.Offset(0, 1)
xlCol = T.Duration / 480
xlCol.WrapText = 1

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If

'Start Date
Set xlCol = xlCol.Offset(0, 1)
xlCol.HorizontalAlignment = xlHAlignRight

If DateFormat(T.Start, pjDate_mm_dd_yy) = "1/1/2010" Then
xlCol = ""
Else
xlCol = DateFormat(T.Start, pjDate_ddd_mm_dd_yy)
End If

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If

'Finish Date
Set xlCol = xlCol.Offset(0, 1)
xlCol.HorizontalAlignment = xlHAlignRight

If T.BaselineFinish = "NA" Then
calcFinishDAte = T.Finish
Else
calcFinishDAte = T.BaselineFinish
End If
If DateFormat(calcFinishDAte, pjDate_mm_dd_yy) = "1/1/2010" Then
xlCol = ""
Else
xlCol = DateFormat(T.Finish, pjDate_ddd_mm_dd_yy)
End If

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If

'Predecessors
Set xlCol = xlCol.Offset(0, 1)
xlCol = T.Predecessors
xlCol.WrapText = 1

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If

'Actual Start
Set xlCol = xlCol.Offset(0, 1)
If T.ActualStart = "NA" Then
xlCol = ""
Else
xlCol = DateFormat(T.ActualStart, pjDate_mm_dd_yy)
End If

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If

'Actual Finish
Set xlCol = xlCol.Offset(0, 1)
If T.ActualFinish = "NA" Then
xlCol = ""
Else
xlCol = DateFormat(T.ActualFinish, pjDate_mm_dd_yy)
End If

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If

'Notes/Comments
Set xlCol = xlCol.Offset(0, 1)
xlCol = T.Notes
xlCol.WrapText = 1

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If


'Resources
For Each Asgn In T.Assignments
Set xlCol = xlCol.Offset(0, 1)
xlCol = Asgn.Resourcename

'Set Font Color/Style based on if summary level as well as
%complete and Finish date information
If T.Summary Then 'If this is a summary level task, make it
bold and black
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 1
ElseIf T.PercentComplete = 100 Then
xlCol.Font.ColorIndex = 1 'Black = Completed tasks
ElseIf T.Finish < Date And T.PercentComplete < 100 Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 3 'Red/Bold = Overdue tasks
ElseIf myStartDate <= Date And T.PercentComplete = 0 And
T.ActualStart = "NA" Then
xlCol.Font.Bold = True
xlCol.Font.ColorIndex = 45 'Orange/Bold = Tasks that should
have started but haven't
ElseIf T.Finish = Date And ((T.PercentComplete 0 And
T.PercentComplete < 100) _
Or (T.ActualStart < "NA" And T.ActualFinish = "NA")) Then
xlCol.Font.ColorIndex = 10 'Green = Tasks that are In Progress
Else
xlCol.Font.ColorIndex = 5 'Blue = Tasks that are upcoming
End If

'Size the Resource columns to fit contents - going to Z allows a
number of resources per task. If you need more columns
'for resources, change the Z to the appropriate column identifier.
xlSheet.Columns("K:Z").AutoFit

Next Asgn

getnext:
Next
AppActivate "Microsoft Project"

'Freezes at the row with column headers then sets the focus back to the
first cell in the sheet
xlApp.Rows("2:2").Select
xlApp.ActiveWindow.FreezePanes = True
xlApp.Range("a1:a1").Select

xlApp.Visible = True

End Sub







"Brenda" wrote:

Hello,

I have a number of macros in MS Project that export data from MS Project to
Excel. These have worked great up until upgrading Excel. My old
configuration was MS Project 2007 and MS Excel 2003. Since upgrading to MS
Excel 2007 it takes considerably longer to run the macros. Additionally, a
coworker who was already on MS Excel 2007 but recently upgraded to MS Project
2007 (though they never used the macros prior to Project 2007) is finding
them to be exceptionally slow as well. Unfortunately, I have no ability to
give any metrics on how long it took prior to the upgrade and how long it is
taking now, but it is a considerable difference. Has anyone else experienced
this and if so, is there a solution? I've done some searches and have found
nothing so far. Let me know if it is critical to see an example of one of
the macros to troubleshoot this.

Thanks!