projectified : VBA

Three Point Estimation (PERT) in Project 2010: Take 1

brianken — Wed, 25 Nov 2009 05:47:04 GMT

As some of you may already know the PERT Addin that was in Project for several versions was NOT included in Project 2010. The good news is that below we have the first version of some sample code you can use to add the feature back into the product! This first version does not use a form like the old one. It uses custom fields at the task level to store the Pessimistic, Optimistic and Most Likely estimates and the weights for each estimate. This is just a preliminary version. We hope to gather feedback and then release a future version of the code as a Visual Studio project that can be customized and used to create a Project 2010 Addin.

This code depends on using 7 task level custom fields:

Field Name	Purpose
Duration1	Optimistic Duration
Duration2	Most Likely Duration
Duration3	Pessimistic Duration
Number1	Optimistic Weight
Number2	Most Likely Weight
Number3	Pessimistic Weight
Text30	Calculation State

The image below shows a Gantt Chart view with these fields inserted. In this example we see weights only on the first task. This is an option you can set in the code. If the option is set to ‘False’ then each task can have its own set of weights. Duration estimates are inserted for each task. The code at this point will estimate every task. (We could add the option to allow a project manager to specify which tasks should be estimated.)

To use this sample code in your own projects:

Open Project 2010
Click on the View Tab of the Ribbon
Click Macro | Visual Basic
Double Click on the “ThisProject (Global.MPT)” node just under the ProjectGlobal node
In the code window that opens up on the right paste in the code below
Decide if you want to use only one set of weights or if you want each task to have its own set of weights
If you want one set leave the code as it is. If you want separate weights then change this: “UseOneSetofWeights = True” to this:
”UseOneSetofWeights = False”
Close the Visual Basic Editor
Click on the “Customize Quick Access Toolbar” item on the ribbon
Click on “More Commands”
In the “Choose commands from” list box pick “Macros”
Select “PERT” in the left hand box and then click the Add button
Click OK

Now the code is ready to be used. All that is left is to insert the fields in the table above into a Gantt Chart view, enter your estimates and your weights (Remember that the weights must add up to 6!!) and then run the macro using the Quick Launch button you just added.

Feedback Wanted!!

This is just a first pass at a sample for replacing the PERT functionality. Please email me (brian.kennemer@microsoft.com) with your feedback.

Some things to think about:

Should there be the ability to specify which tasks should have their Durations estimated when the tool is run?
Do you prefer a form for setting the weights?
What other options would you like to see?

One last thing: This is just sample code and should be thoroughly tested before you use it on a ‘production’ project.

_____________________________________________________________________________________________________________

Sub PERT()
Dim tskT As Task
Dim tskFirst As Task
Dim FoundBadWeights As Boolean
Dim UseOneSetofWeights As Boolean

UseOneSetofWeights = True
FoundBadWeights = False

CustomFieldRename FieldID:=pjCustomTaskDuration1, NewName:="Optimistic Duration"
CustomFieldRename FieldID:=pjCustomTaskDuration2, NewName:="Most Likely Duration"
CustomFieldRename FieldID:=pjCustomTaskDuration3, NewName:="Pessimistic Duration"
CustomFieldRename FieldID:=pjCustomTaskNumber1, NewName:="Optimistic Weight"
CustomFieldRename FieldID:=pjCustomTaskNumber2, NewName:="Most Likely Weight"
CustomFieldRename FieldID:=pjCustomTaskNumber3, NewName:="Pessimistic Weight"
CustomFieldRename FieldID:=pjCustomTaskText30, NewName:="PERT State"

If UseOneSetofWeights = True Then
    Set tskFirst = ActiveProject.Tasks(1)
    For Each tskT In ActiveProject.Tasks
      If Not (tskT Is Nothing) Then
        If tskT.PercentComplete = 0 And tskT.PercentWorkComplete = 0 Then
          If (tskFirst.Number1 + tskFirst.Number2 + tskFirst.Number3) = 6 Then
            tskT.Duration = ((((tskT.Duration1) * tskFirst.Number1) _
            + ((tskT.Duration2) * tskFirst.Number2) _
            + ((tskT.Duration3) * tskFirst.Number3)) / 6)
            tskT.Text30 = "Duration Calc'd: " & Now()
          Else
            tskT.Text30 = "Not Calc'd: Weights <> 6"
            FoundBadWeights = True
          End If
        Else
          tskT.Text30 = "Not Calc'd: Task In Progress or Complete"
        End If
      End If
    Next tskT
Else
    For Each tskT In ActiveProject.Tasks
      If Not (tskT Is Nothing) Then
        If tskT.PercentComplete = 0 And tskT.PercentWorkComplete = 0 Then
          If (tskT.Number1 + tskT.Number2 + tskT.Number3) = 6 Then
            tskT.Duration = ((((tskT.Duration1) * tskT.Number1) _
            + ((tskT.Duration2) * tskT.Number2) _
            + ((tskT.Duration3) * tskT.Number3)) / 6)
            tskT.Text30 = "Duration Calc'd: " & Now()
          Else
            tskT.Text30 = "Not Calc'd: Weights <> 6"
            FoundBadWeights = True
          End If
        Else
          tskT.Text30 = "Not Calc'd: Task In Progress or Complete"
        End If
      End If
    Next tskT
End If
If FoundBadWeights = True Then
    MsgBox Prompt:="Some Tasks Weight Values were found to be incorrect." & _
    Chr(13) & "Check the Text30 fields for details.", Buttons:=vbCritical, _
    Title:="WorkPERT Weights Error"
End If
End Sub

Code to Show Which Tasks have Which Baselines Saved

brianken — Sat, 21 Mar 2009 02:38:43 GMT

Here is a sample of some VBA code that will populate the Task Text30 field with the numbers of the baselines for which each task has values saved. This is useful if you are using lots of the baselines but not all your tasks have had all the baselines saved.

For example:

“Task” has values in Baseline, Baseline2, Baseline4 and Baseline9 while “Other Task” only has values in Baseline2.

   1:  Sub WhichBaselinesSaved()

   2:  Dim t As Task

   3:  Dim i As Long

4:

   5:  For Each t In ActiveProject.Tasks

   6:      If Not (t Is Nothing) Then

   7:          t.Text30 = ""

   8:          For i = 0 To 10

   9:              If i = 0 Then

  10:                  If t.BaselineStart < 50000 Then

  11:                      t.Text30 = t.Text30 & i & ", "

  12:                  End If

  13:              ElseIf Not t.GetField(Application.FieldNameToFieldConstant("Baseline" _

  14:              & i & "Start", pjTask)) = "NA" Then

  15:                      t.Text30 = t.Text30 & i & ", "

  16:              End If

  17:          Next i

  18:          t.Text30 = Left$(t.Text30, Len(t.Text30) - 2)

  19:      End If

20:

  21:  Next t

  22:  End Sub

Moving Tasks With VBA

brianken — Tue, 07 Oct 2008 06:17:09 GMT

So the problem was that a customer wanted to be able to move a task that was at ID 7 and move it so that it was at ID 2. Sadly, VBA for Project does not contain a Task.Move method. But with a little bit of code around them you can use a Cut and Paste methods for Rows.

The example below assumes that you know the name of the task you want to move and the name of the task that currently occupies the row where you want to move the first task.

Here is a sample task list. This sample is a good test because the tasks are out of ID order. The task I want to move (name = 7) is in ID position 3 and I want to move it to where Task 2 is now (currently in ID position 9.)

Sub TaskMover()
Dim t As Task
Dim NewID As Integer

For Each t In ActiveProject.Tasks
    If Not (t Is Nothing) Then
        If t.Name = 2 Then
            NewID = t.ID
        End If
        If t.Name = 7 Then
            SelectRow Row:=t.ID, Rowrelative:=False
            EditCut
        End If
    End If
Next t

SelectRow Row:=NewID, Rowrelative:=False
EditPaste

End Sub

This code is not very elegant in that it requires us to select a row and then cut it and then select another row and then paste it. It also requires that the view in the activewindow is a Task view. There is some code we can use to test to make sure the view is the right type. “ActiveWindow.TopPane.View.Type” should be “0” or “pjTaskItem”. So it is not perfect but it gets the job done. You can use this as a starting point for your own needs.

So the new code with this view type test would look like this:

Sub TaskMover()
Dim t As Task
Dim NewID As Integer
If ActiveWindow.TopPane.View.Type = pjTaskItem Then
    For Each t In ActiveProject.Tasks
        If Not (t Is Nothing) Then
            If t.Name = 2 Then
                NewID = t.ID
            End If
            If t.Name = 7 Then
                SelectRow Row:=t.ID, Rowrelative:=False
                EditCut
            End If
        End If
    Next t
    SelectRow Row:=NewID, Rowrelative:=False
    EditPaste
End If
End Sub

No Thanks, I’ll Be Having the Crow

brianken — Fri, 18 Jul 2008 15:43:12 GMT

File this under reason 467 why I don’t make my living as a full time developer.

Yesterday I posted some code for parsing out a comma delimited text field, such as a multi-value enterprise field in Project Server 2007.

Today a real developer pointed out that there is a function that does the same thing as my code. DOH!

So here is the new code, most of which is just there to display the results of the function.

Sub Doh()
Dim count As Long

Dim Values As Variant

Values = Split(ActiveProject.Tasks(1).Text1, ",")

'just for display
For count = 0 To UBound(Values)
Debug.Print Trim(Values(count))
Next count
'----------------
End Sub

VBA Code For Parsing a MultiValue Text Field

brianken — Thu, 17 Jul 2008 21:43:03 GMT

If you are in Project Server 2007 you can have an Enterprise Text using a lookup table that can contain more than one value. If you then need to work with that field data in code (VBA or VSTO) you can use the GetField function to get the value of that field. The catch is that it is returned as a comma delimited string with all the values in it. So if your field had three values selected (Value1, Value19 and Value26) it gets returned as “Value1, Value19, Value26”.

The code below shows how to parse this into an array where it will be easier to work with in code.

As always, take this code and make it your own. This includes doing testing to make sure it does what it is supposed to do. It worked for me on a very limited set of test data. Don’t just throw this into production. ;-)

Sub Parse_Comma_Delimited_Field_Into_Array()

Dim Char As Integer
'Char is used to hold each character in the string to see if it is a comma

Dim WholeField As String
'Wholefield is a string that holds the entire value of the field to be parsed

Dim Values() As String
'Values is the string array that will contain the parsed values

Dim NumberofValues As Integer
'NumberofValues holds the number of values in the 'wholefield'
'so that the 'Values' array can be redim'd

Dim StartofLastValue As Integer
'holds the number of characters from the left of the string where the last
'word started so the value can be pulled from the wholefield string and
'placed into the array

StartofLastValue = 1
NumberofValues = 0

'---Setting value of WholeField to be parsed
WholeField = ActiveProject.Tasks(1).Text1
'---
If Len(WholeField) > 0 Then
    For Char = 1 To Len(WholeField)
        If Mid$(String:=WholeField, Start:=Char, Length:=1) = "," _
        Or Char = Len(WholeField) Then
            NumberofValues = NumberofValues + 1
            ReDim Preserve Values(1, NumberofValues)
            If Char < Len(WholeField) Then
                Values(1, NumberofValues) = Trim(Mid$(String:=WholeField, _
                Start:=StartofLastValue, Length:=Char - StartofLastValue))
            Else
                Values(1, NumberofValues) = Trim(Mid$(String:=WholeField, _
                Start:=StartofLastValue, Length:=Char - (StartofLastValue - 1)))
            End If
            StartofLastValue = Char + 1
        End If
    Next Char
    '-------------------------
        'this section just loops through and shows that the array
        'contains the correct data.
        'Remove after you are finished testing
        Dim count As Integer
        For count = 1 To NumberofValues
            Debug.Print Values(1, count)
        Next count
    '-------------------------

End If
End Sub