Hi Fellow Forum Members
I have been trying for some time to speed up a piece of code that I had help with producing on this forum. However I have failed miserably. This code is run from a master file and opens up to 8 other MSP files to extract data and bring it back to the master file. It is taking around 30 to 40 minutes to run. I would appreciate some help in trying to speed it up. The code is shown below:
Sub EA_Release2_CPP_Update() Dim pjApp As MSProject.Application Dim FileToOpen Dim Proj As MSProject.Project Dim ts As Tasks Dim t As Task Dim fd As FileDialog Dim uid As Integer Dim ws As String Dim sDate As Long Dim Row As Integer Dim wsCount As Integer Set pjApp = MSProject.Application Set ts = ActiveProject.Tasks If pjApp Is Nothing Then MsgBox "Project is not installed" End End If pjApp.Visible = True AppActivate "Microsoft Project" Application.DisplayAlerts = False Application.Calculation = xlManual For Each t In ts Row = t.ID If Not t Is Nothing Then If Not t.Summary Then tws = t.GetField(FieldNameToFieldConstant("Text16")) tuid = t.GetField(FieldNameToFieldConstant("Text12")) If tws <> "" Then On Error GoTo ErrorHandler Application.FileOpenEx Name:="D:\Delivery Assurance\01 EA Dashboard\With GivesGets\" & tws & ".mpp", ReadOnly:=False, FormatID:="MSProject.MPP" 'Projects("EA Release 2 CPP.mpp").Tasks(Row).Duration = ActiveProject.Tasks.UniqueID(tuid).Duration Projects("EA Release 2 CPP.mpp").Tasks(Row).Start = ActiveProject.Tasks.UniqueID(tuid).Start Projects("EA Release 2 CPP.mpp").Tasks(Row).Finish = ActiveProject.Tasks.UniqueID(tuid).Finish Projects("EA Release 2 CPP.mpp").Tasks(Row).PercentComplete = ActiveProject.Tasks.UniqueID(tuid).PercentComplete Projects("EA Release 2 CPP.mpp").Tasks(Row).BaselineFinish = ActiveProject.Tasks.UniqueID(tuid).BaselineFinish Projects("EA Release 2 CPP.mpp").Tasks(Row).Text4 = ActiveProject.Tasks.UniqueID(tuid).Text4 ' FileClose pjDoNotSave End If End If End If Next t GoTo Finish: ErrorHandler: MsgBox ("Either the plan " & tws & ".mpp" & " is not available or the UID (" & tuid & ") in the source plan has changed. Please check and re-run this routine." _& "This routine will now exit and you will need to re-run it once you have corrected the missing details.") Exit Sub 'pjApp.FileClose pjDoNotSave Finish: Application.Calculation = xlAutomatic FilterApply Name:="All Tasks" 'pjApp.Quit Set pjApp = Nothing Application.DisplayAlerts = True MsgBox ("EA Dashboard Updated.....") End Sub
Many thanks in anticipation.
Tony
TKHussar