2
\$\begingroup\$

This copies data from a project into Excel to be calculated into a final report. The code runs pretty slowly at this point and I would like it to be a little bit faster. Are there any blatant coding mishaps that are slowing the calculations down?

Sub Update_Schedule()
Dim appProj As MSProject.Application
Dim aProg As MSProject.Project
Dim sel As MSProject.Selection
Dim ts As Tasks
Dim t As Task
Dim rng As Range
Dim rng2 As Range
Dim ws As Worksheet
Dim ws2 As Worksheet


Application.DisplayAlerts = False

'Clear current contents

Set ws2 = Worksheets("Final Report")

Set ws = Worksheets("Master")
Set rng = ws.Range("A:F")
rng.ClearContents
Set ws = Worksheets("Resource List")
Set rng = ws.Range("A:B")
rng.ClearContents

'Open the Project file when it asks to open resource pool, press yes

Set appProj = CreateObject("Msproject.Application")

appProj.DisplayAlerts = False

appProj.FileOpen "File_1.mpp" 'also opens file 2

Set aProg = appProj.Projects("File_1.mpp")

appProj.Visible = True

WindowActivate WindowName:=aProg

'Copy the project columns and paste into Excel

Set ts = aProg.Tasks
SelectTaskColumn Column:="Name"
OutlineShowAllTasks
OutlineShowAllTasks
EditCopy
Set ws = Worksheets("Master")
Set rng = ws.Range("A:A")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Duration"
EditCopy
Set rng = ws.Range("B:B")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Start"
EditCopy
Set rng = ws.Range("C:C")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws.Range("D:D")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Resource Names"
EditCopy
Set rng = ws.Range("E:E")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Project"
EditCopy
Set rng = ws.Range("F:F")
ActiveSheet.Paste Destination:=rng
WindowActivate WindowName:="\\File_2.mpp"
SelectResourceColumn Column:="Name"
EditCopy
Set ws = Worksheets("Resource List")
Set rng = ws.Range("A:A")
ActiveSheet.Paste Destination:=rng
SelectResourceColumn Column:="Category"
EditCopy
Set rng = ws.Range("B:B")
ActiveSheet.Paste Destination:=rng

'Populates formula in Master sheet
Application.Visible = True

Set ws = Worksheets("Master")
Set rng = ws.Range("G2")
Set rng2 = ws.Range("G2:G9223")
rng.AutoFill Destination:=rng2, Type:=xlFillDefault
Set rng = ws.Range("H2")
Set rng2 = ws.Range("H2:H9223")
rng.AutoFill Destination:=rng2, Type:=xlFillDefault

Calculate

ws2.Visible = True

Application.DisplayAlerts = True
appProj.DisplayAlerts = True
End Sub
\$\endgroup\$
  • \$\begingroup\$ Opening up MS Project, and opening up a file in it will be slow. If that's the slow part, it might be ard to speed it up. I would suggest adding a Debug.Print with the timestemp after each line to see which ones are slow. \$\endgroup\$ – Justin Dearing Aug 5 '15 at 16:20
  • \$\begingroup\$ I've done some debugging and the slowest part is actually the part under the comment "populates formula in master sheet." It may just be that filling in the formula takes awhile. \$\endgroup\$ – Seth39195 Aug 5 '15 at 18:20
  • 1
    \$\begingroup\$ Do you always have data down to row 9,223? If you might have much less data, you might see significant improvement if you figure out how much data you actually have and then fill down that number of rows. \$\endgroup\$ – ChipsLetten Aug 6 '15 at 16:13
  • \$\begingroup\$ I usually don't have data that far down. Is there a good way to fill to just the last cell? \$\endgroup\$ – Seth39195 Aug 6 '15 at 17:36
  • \$\begingroup\$ If you search on Stack Overflow you will find examples of how to find the last row/cell. \$\endgroup\$ – ChipsLetten Aug 7 '15 at 10:17
3
\$\begingroup\$

My earlier comment was: Do you always have data down to row 9,223? If you might have much less data, you might see significant improvement if you figure out how much data you actually have and then fill down that number of rows.

Here is an example of code:

Set ws = Worksheets("Master")
Dim lastRow As Long
lastRow = LastRowNum(ws.Name, "A")
Set rng = ws.Range("G2")
Set rng2 = ws.Range("G2:G" & lastRow)
rng.AutoFill Destination:=rng2, Type:=xlFillDefault
Set rng = ws.Range("H2")
Set rng2 = ws.Range("H2:H" & lastRow)
rng.AutoFill Destination:=rng2, Type:=xlFillDefault

...
End Sub

Function LastRowNum(sheetName As String, columnLetter As String) As Long

    With ThisWorkbook.Worksheets(sheetName)
        LastRowNum = .Range(columnLetter & .Rows.Count).End(xlUp).Row
    End With

End Function
\$\endgroup\$
  • \$\begingroup\$ Thanks, I've had some success with code similar to this. \$\endgroup\$ – Seth39195 Aug 10 '15 at 12:38
  • \$\begingroup\$ If you are happy with one of the answers, please remember to mark it as accepted. \$\endgroup\$ – ChipsLetten Aug 12 '15 at 9:06
3
\$\begingroup\$

A few things here:

  • Read this. Its lists things to do when copying large amounts of data
  • Did you set Application.Calculation = xlCalculationManual? Your manually calling Calculate, but you never turn off autocalcualtion.
  • Did you set Application.ScreenUpdating = FALSE? That can speed things up.
\$\endgroup\$
  • \$\begingroup\$ Auto calculation is turned off in the excel file. Am I correct in thinking that it will remain off while running the macro? \$\endgroup\$ – Seth39195 Aug 5 '15 at 19:47
  • \$\begingroup\$ Yes, it will be off. you Could, to be safe, save the value of Application.Calcualtion to a variable, then turn it off then restore it to the old value. What about toggling screen updating? \$\endgroup\$ – Justin Dearing Aug 5 '15 at 19:50

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.