Macro for Filtering based on “Task Path” in Microsoft Project

Here in the TaskPathFilters module, I provide five simple macros for applying a filter (or table highlighting) that corresponds to Task Path bar highlighting output.

For users of Microsoft Project 2013+, including the desktop versions of Project for Office 365, the Task Path bar styles provide a useful method for highlighting logical connections between tasks.  Four different sets of bar styles can be created, corresponding to the Predecessors, Driving Predecessors, Successors, and Driven Successors of the selected task.  Unfortunately, the “show for…” criteria used to apply the bar styles are not available for creating a filtered display of tasks – say the driving path to a key milestone – while hiding the non-driving tasks.

[The “driving” and “driven” Task Paths are defined (by MSP) using the task StartDriver object, the same as in the Task Inspector.  As shown here, StartDriver has proven unreliable in identifying driving logic in the presence of non-FS relationships, actual progress, splits, and resource leveling.

In another blog entry here, you can find a set of macros for duplicating the results of the Task Path bars, with the added benefit of being able to re-sort tasks according to logic flow, so concurrent logic paths are easily separated.  Those macros use the same underlying data as Task Paths, so their results should be identical to these.  Unlike these, they can be used in versions of MSP prior to 2013.]

Here’s the code (requires MSP 2013+).

Note, for real logic analysis, have a look at BPC Logic Filter.

'TaskPathFilters Module
'This module includes four procedures to mark tasks according to their TaskPath
'characteristics.  A fifth procedure applies a filter to display only the marked tasks.
'The module is intended only for users of Microsoft Project 2013+, which incorporates TaskPath
'formatting of task bars.  If the applicable TaskPath formatting has not been applied,
'then no filter will be created.  VBA code developed by TMBoyle, 14Sep'18
'   1. Install all code into a new module, with "TaskPathFilters Module" above as the top line.
'   2. Assign buttons or hotkeys to the first four procedures only (the other one is called by these):
        'a. AllTaskPathFilter() - Filters all the marked task paths.
        'b. TaskPathPredecessorFilter() - Filters the marked "predecessors" of the selected task.
        'c. TaskPathDrivingPredecessorFilter() - Filters the marked "driving predecessors" of the selected task.
        'd. TaskPathSuccessorFilter() - Filters the marked "successors" of the selected task.
        'e. TaskPathDrivenSuccessorFilter() - Filters the marked "driven successors" of the selected task.
'
Public MsgBase As String, Tsel As Task
Sub AllTaskPathFilter()
    Dim t As Task
    Dim Apply As Boolean
    
    Set Tsel = ActiveCell.Task
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
            If (t.PathPredecessor = True) Or (t.PathDrivingPredecessor = True) Or _
                (t.PathSuccessor = True) Or (t.PathDrivenSuccessor = True) Then
                t.Marked = True
                Apply = True
            Else
                t.Marked = False
            End If
        End If
    Next t
    Tsel.Marked = "Yes"
    If Apply Then
        MarkedFilter
        MsgBox (MsgBase & "All Selected for task " & vbCrLf & _
            Tsel.ID & " - " & Tsel.Name)
    Else
        MsgBox "No Filter Applied."
    End If
End Sub
Sub TaskPathPredecessorFilter()
    Dim t As Task
    Dim Apply As Boolean
    
    Set Tsel = ActiveCell.Task
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
            If t.PathPredecessor = True Then
                t.Marked = True
                Apply = True
            Else
                t.Marked = False
            End If
        End If
    Next t
    Tsel.Marked = "Yes"
    If Apply Then
        MarkedFilter
        MsgBox (MsgBase & "Predecessors of task " & vbCrLf & _
            Tsel.ID & " - " & Tsel.Name)
    Else
        MsgBox "No Filter Applied."
    End If
End Sub

Sub TaskPathDrivingPredecessorFilter()
    Dim t As Task
    Dim Apply As Boolean
    
    Set Tsel = ActiveCell.Task
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
            If t.PathDrivingPredecessor = True Then
                t.Marked = True
                Apply = True
            Else
                t.Marked = False
            End If
        End If
    Next t
    Tsel.Marked = "Yes"
    If Apply Then
        MarkedFilter
        MsgBox (MsgBase & "Driving Predecessors of task " & vbCrLf & _
            Tsel.ID & " - " & Tsel.Name)
    Else
        MsgBox "No Filter Applied."
    End If
End Sub

Sub TaskPathSuccessorFilter()
    Dim t As Task
    Dim Apply As Boolean
    
    Set Tsel = ActiveCell.Task
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
            If t.PathSuccessor = True Then
                t.Marked = True
                Apply = True
            Else
                t.Marked = False
            End If
        End If
    Next t
    Tsel.Marked = "Yes"
    If Apply Then
        MarkedFilter
        MsgBox (MsgBase & "Successors of task " & vbCrLf & _
            Tsel.ID & " - " & Tsel.Name)
    Else
        MsgBox "No Filter Applied."
    End If
End Sub

Sub TaskPathDrivenSuccessorFilter()
    Dim t As Task
    Dim Apply As Boolean
    
    Set Tsel = ActiveCell.Task
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
            If t.PathDrivenSuccessor = True Then
                t.Marked = True
                Apply = True
            Else
                t.Marked = False
            End If
        End If
    Next t
    Tsel.Marked = "Yes"
    If Apply Then
        MarkedFilter
        MsgBox (MsgBase & "Driven Successors of task " & vbCrLf & _
            Tsel.ID & " - " & Tsel.Name)
    Else
        MsgBox "No Filter Applied."
    End If
End Sub

Sub MarkedFilter()
Dim HL As Boolean

    If MsgBox("Apply Highlighting Only?", vbYesNo) = vbYes Then
        HL = True
        MsgBase = "Highlighting TaskPath "
    Else
        MsgBase = "Filtered for TaskPath "
    End If
    On Error Resume Next
    FilterApply Name:="Marked Tasks", Highlight:=HL
    If Err.Number <> 0 Then
        FilterEdit Name:="Marked Tasks", TaskFilter:=True, Create:=True, OverwriteExisting:=True, _
           FieldName:="Marked", Test:="equals", Value:="Yes", ShowInMenu:=True, ShowSummaryTasks:=True
        FilterApply Name:="Marked Tasks", Highlight:=HL
    End If
    EditGoTo ID:=Tsel.ID
End Sub


How to Filter for Leads and Lags in Microsoft Project

Here are two macro procedures – LagFilter and LeadFilter – for creating and applying a filter to show only tasks with leads or lags above a certain threshold value.

Using Lags and/or Leads (i.e. negative lags) in Project Scheduling is discouraged for good reasons.  In most project scheduling software it is easy to identify violations by creating a filter to show only tasks with Lags (or Leads) in their predecessor relationships.

In Microsoft Project, lags are indicated by the presence of a “+” character in the task’s predecessors field.  Here is the corresponding filter specification.

You can augment the filter to show tasks on both sides of the lags:

Leads are indicated (in MSP) by the presence of a “-” character in the task’s predecessors field.  Here is the corresponding filter specification (showing both sides of the leads).

Unfortunately, these simple filters don’t help to differentiate high-lag/lead relationships from low-lag/lead relationships.  All of them are lumped together in the same filter.  It is possible to create filters for only the highest lead/lag values using a number of custom fields with complex formulas.  It is far simpler, however, to create the necessary filters using vba/macros.

Here are two macro procedures – LagFilter and LeadFilter – for creating and applying a filter to show only tasks with leads or lags above a certain threshold value.  Choosing a zero-value threshold leads to the same results as the simple filters above.  These procedures work by examining the lag of each predecessor relationship of every task in the active project, comparing it to the specified threshold value.  If the lag is high enough, then the Flag6 field of the task will be set to “yes”.  At the end, a new filter is made and applied.  Note that these macros will overwrite any values in the Flag6 field of your project, unless Flag6 is already controlled by a formula.  (In that case, the macros will crash with an error.)  You may need to edit the macros to select a different Flag field.

[I’ve edited these macros… a) to allow the user to select whether to show both sides or only one side (the successor) of each lead/lag; b) to avoid null filters (i.e. blank screens) by applying the filter only when leads or lags matching the criterion are found; and c) to allow work-time, elapsed-time, or percentage-based lead/lag criteria.]

To apply these, simply copy and paste them into a new module in your Project Visual Basic editor (VBE).  (I typically keep these modules in the global.mpt file, though that practice is not always recommended.)  You can then run them directly from the VBE or from custom buttons that you link to the macros through the  “Customize the Ribbon” dialog.

Sub LagFilter()
'Copyright 15August2018 by T.Boyle PE, PSP
'This macro collects user input and filters the active project to display only tasks
'with dependency lags that are less than the user-specified threshold.  The threshold
'may be specified in units of working time, elapsed time, or percentage.  The filter
'is applied using the Flag6 custom field.
'FLAG6 WILL BE OVER-WRITTEN, IF POSSIBLE,OR THIS MACRO WILL CRASH.

    Dim t As Task
    Dim d As TaskDependency
    Dim LagUnits As String
    Dim ElapsedUnits As Boolean
    Dim LagThreshold As Double
    Dim LagLimit As String
    Dim SuccsOnly As Boolean
    Dim Filtername As String
    Dim Found As Boolean
    
    Found = False
    'Get lag units from user
    LagUnits = (InputBox("Enter lag units (m,h,d,w,mo,em,eh,ed,ew,emo,%):"))
    'Validate units
    Select Case LagUnits
        Case "m", "h", "d", "w", "mo", "em", "eh", "ed", "ew", "emo", "%"
            'Get the filter limit from user
            LagThreshold = (InputBox("Enter lag threshold (" & LagUnits & "):"))
            LagLimit = LagThreshold & " " & LagUnits
            If Left(LagUnits, 1) = "e" Then ElapsedUnits = True
        Case Else
            MsgBox ("Invalid lag units entered (case-sensitive). Aborting.")
            Exit Sub
    End Select
    'Convert units
    Select Case LagUnits
        Case "m"
            'proceed
        Case "h"
            LagThreshold = LagThreshold * 60
        Case "d"
            LagThreshold = LagThreshold * 60 * ActiveProject.HoursPerDay
        Case "w"
            LagThreshold = LagThreshold * 60 * ActiveProject.HoursPerWeek
        Case "mo"
            LagThreshold = LagThreshold * 60 * ActiveProject.HoursPerDay * ActiveProject.DaysPerMonth
        Case "em"
            'proceed
        Case "eh"
            LagThreshold = LagThreshold * 60
        Case "ed"
            LagThreshold = LagThreshold * 60 * 24
        Case "ew"
            LagThreshold = LagThreshold * 60 * 24 * 7
        Case "emo"
            LagThreshold = LagThreshold * 60 * 24 * 30
        Case "%"
            'proceed
    End Select
    
    If MsgBox("Display both Predecessors and Successors?" & vbCrLf & "(""Yes"" shows each lag twice. Default " _
            & "shows Successors Only)", vbQuestion + vbYesNo + vbDefaultButton2, "???") = vbYes Then
        SuccsOnly = False
        Filtername = "HasLagsAboveThreshold"
    Else
        SuccsOnly = True
        Filtername = "HasPredecessorLagsAboveThreshold"
    End If
    
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
            Call ClearT(t)
            For Each d In t.TaskDependencies
                If (d.To = t) Or (SuccsOnly = False) Then
                    If (d.Lag > 0 And LagThreshold = 0) Or (d.Lag >= LagThreshold And LagThreshold > 0) Then
                            If (d.LagType = 19 And LagUnits = "%") Then
                                Call MarkT(t, Found)
                            ElseIf (d.LagType Mod 2 = 1 And (Not ElapsedUnits) And (LagUnits <> "%")) Then
                                Call MarkT(t, Found)
                            ElseIf (d.LagType Mod 2 = 0 And ElapsedUnits) Then
                                Call MarkT(t, Found)
                            End If
                    End If
                End If
            Next d
        End If
    Next t
    
    If Found Then
        FilterEdit Name:=Filtername, TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Flag6", _
            Test:="equals", Value:="Yes", ShowInMenu:=True, ShowSummaryTasks:=True
        FilterApply Name:=Filtername
        MsgBox ("Filter applied: " & Filtername & vbCrLf & "Filter Threshold: " & LagLimit)
    Else
        MsgBox ("No lags found above threshold (" & LagLimit & "). No filter applied")
    End If

End Sub

Sub LeadFilter()
'Copyright 15August2018 by T.Boyle PE, PSP
'This macro collects user input and filters the active project to display only tasks
'with dependency leads (i.e. negative lags) that are less than the user-specified threshold.
'The threshold may be specified in units of working time, elapsed time, or percentage.
'The filter is applied using the Flag6 custom field.
'FLAG6 WILL BE OVER-WRITTEN, IF POSSIBLE,OR THIS MACRO WILL CRASH.

    Dim t As Task
    Dim d As TaskDependency
    Dim LeadUnits As String
    Dim ElapsedUnits As Boolean
    Dim LeadThreshold As Double
    Dim LeadLimit As String
    Dim SuccsOnly As Boolean
    Dim Filtername As String
    Dim Found As Boolean
    
    Found = False
    'Get Lead units from user
    LeadUnits = (InputBox("Enter Lead units (m,h,d,w,mo,em,eh,ed,ew,emo,%):"))
    'Validate units
    Select Case LeadUnits
        Case "m", "h", "d", "w", "mo", "em", "eh", "ed", "ew", "emo", "%"
            'Get the filter limit from user
            LeadThreshold = (InputBox("Enter Lead threshold (" & LeadUnits & "):"))
            LeadLimit = LeadThreshold & " " & LeadUnits
            If Left(LeadUnits, 1) = "e" Then ElapsedUnits = True
        Case Else
            MsgBox ("Invalid Lead units entered (case-sensitive). Aborting.")
            Exit Sub
    End Select
    'Convert units
    Select Case LeadUnits
        Case "m"
            'proceed
        Case "h"
            LeadThreshold = LeadThreshold * 60
        Case "d"
            LeadThreshold = LeadThreshold * 60 * ActiveProject.HoursPerDay
        Case "w"
            LeadThreshold = LeadThreshold * 60 * ActiveProject.HoursPerWeek
        Case "mo"
            LeadThreshold = LeadThreshold * 60 * ActiveProject.HoursPerDay * ActiveProject.DaysPerMonth
        Case "em"
            'proceed
        Case "eh"
            LeadThreshold = LeadThreshold * 60
        Case "ed"
            LeadThreshold = LeadThreshold * 60 * 24
        Case "ew"
            LeadThreshold = LeadThreshold * 60 * 24 * 7
        Case "emo"
            LeadThreshold = LeadThreshold * 60 * 24 * 30
        Case "%"
            'proceed
    End Select
    
    If MsgBox("Display both Predecessors and Successors?" & vbCrLf & "(""Yes"" shows each Lead twice. Default " _
            & "shows Successors Only)", vbQuestion + vbYesNo + vbDefaultButton2, "???") = vbYes Then
        SuccsOnly = False
        Filtername = "HasLeadsAboveThreshold"
    Else
        SuccsOnly = True
        Filtername = "HasPredecessorLeadsAboveThreshold"
    End If
    
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
            Call ClearT(t)
            For Each d In t.TaskDependencies
                If (d.To = t) Or (SuccsOnly = False) Then
                    If (d.Lag < 0 And LeadThreshold = 0) Or (d.Lag <= -1 * LeadThreshold And LeadThreshold > 0) Then
                            If (d.LagType = 19 And LeadUnits = "%") Then
                                Call MarkT(t, Found)
                            ElseIf (d.LagType Mod 2 = 1 And (Not ElapsedUnits) And (LeadUnits <> "%")) Then
                                Call MarkT(t, Found)
                            ElseIf (d.LagType Mod 2 = 0 And ElapsedUnits) Then
                                Call MarkT(t, Found)
                            End If
                    End If
                End If
            Next d
        End If
    Next t
    
    If Found Then
        FilterEdit Name:=Filtername, TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Flag6", _
            Test:="equals", Value:="Yes", ShowInMenu:=True, ShowSummaryTasks:=True
        FilterApply Name:=Filtername
        MsgBox ("Filter applied: " & Filtername & vbCrLf & "Filter Threshold: " & LeadLimit)
    Else
        MsgBox ("No Leads found above threshold (" & LeadLimit & "). No filter applied")
    End If

End Sub

Sub ClearT(t As Task)
    t.Flag6 = "No"
End Sub
Sub MarkT(ByRef t As Task, ByRef Found As Boolean)
    t.Flag6 = "Yes"
    Found = True
End Sub

Neither the simple filter nor the macro provided here implements the algorithm used by the Project Logic Checker in our BPC Logic Filter Add-In, which incorporates a slightly different premise.  That is: a relationship (or combination of relationships) with (positive or negative) lag may be the most effective and efficient method for modeling the true sequential restraints of the work, but only when the lag represents a relatively small proportion of the durations of the related tasks.  Thus, the Project Logic Checker flags tasks where the relationship lead/lag exceeds a certain percentage of the associated task durations.

An Alternate Approach to Hammock Tasks in Microsoft Project

This entry describes the basis for hammock-type summary tasks and introduces an alternate method (and UpdateHammocks macro) for creating and maintaining such tasks in Microsoft Project (MSP) schedules.

Hammocks and LOE Tasks

“Hammock”* and “Level of Effort” (LOE) tasks in project schedules provide two similar approaches to summarizing and reporting the overall time consumed by a collection of other tasks.  Typically, hammock or LOE tasks are used to represent the indirect management and other support activities associated with the primary tasks, and they are often loaded with management and other indirect resources.  Hammock and LOE tasks are essentially the same, though minor differences exist in the implementation by different software.  Since hammocks and LOE tasks do not possess any driving logic, they should be excluded from any formal definition of the Critical Path for the project.

* The “hammock” name refers to the simple method of suspending a sleeping net or cloth (i.e. the hammock) between two trees.  When first described in hand-drawn activity-on-arrow (AOA) network diagrams, the time-summarizing activity took the shape of a simple curved line slung between two nodes – i.e. a hammock.

Hammocks in Primavera

Primavera scheduling tools have long provided explicit activity types for specifying hammock or LOE activities.  Primavera Project Planner (P3) and Primavera SureTrak Project Manager, for example, both included specific hammock activity types that would be specially treated in the schedule calculations.  The start dates for a hammock were defined by its Start-Start predecessors; finish dates came from its Finish-Finish successors; the same activity could not be included in both groups.  Oracle’s Primavera P6, a newer application, allows for LOE activities that inherit their dates from the primary tasks that are included in their “predecessors” and “successors” lists.  They are substantially more flexible than P3’s hammocks.  In most respects the scheduling aspects of these LOE activities are similar to the scheduling of summary bars in P6 schedules (and summary tasks in MSP), with the key difference being that there is no need for common hierarchical structure or activity coding of the related primary activities.

Hammocks in Other Tools

Most other major project scheduling tools also have special-purpose hammock task types.  For example, Phoenix Project Manager, Spider Project, and Deltek Open Plan all provide traditional hammock activity types, whose start and finish are defined by specific logical relationships.  Asta PowerProject also includes a “hammock” task whose construction is more like that of an independent summary activity.  That is, it is not necessary to indicate start/finish relationships.  In general, the number of activities being summarized by the hammocks (or LOEs in P6) are not practically limited.

OLE Hammocks in MSP

MSP has never included an explicit Hammock or LOE task type, and since summary tasks do not provide the needed solution in many cases, a subtle method for constructing simple hammock tasks was created.  As described here, the method involves copying the start/finish dates from two primary tasks and using a paste-special command to link these dates to the dates of the “hammock” task.  The resulting “links” – based on common Windows OLE (object linking and embedding) technology rather than explicit logical schedule relationships – remain essentially hidden and cannot be easily described or audited in an MSP schedule.

MSP’s response to changes in the linked dates is similar to its response when dates are entered manually: i.e. it sets an early constraint (SNET or FNET) and adjusts the task duration so that the task spans between the two linked dates.  Unfortunately, even if the links remain stable and updated (which is not guaranteed), the sources of these adjustments remain hidden.

MSP OLE Hammock Issues

In addition to the absence of auditable schedule information, regular users of linked hammocks may have noticed the following issues, which are present in MSP Professional 2010 and later releases:

  1. OLE hammocks are limited to summarizing only two tasks, one task providing the start date and the other providing the finish.  This limitation seems most consistent with the original description of hammocks in AOA networks, but it doesn’t exist in other modern software.  Often the activities being summarized are potentially concurrent, and it is preferred to allow the software to select dates from the group.
  2. MSP does not prevent the assignment of additional logical links or other constraints that may conflict with the OLE links.
  3. Creating new linked hammocks by copying and modifying existing linked hammocks – say as part of a fragnet replication – doesn’t work well. The resulting links may be subject to corruption and won’t update reliably.  The only reliable way to create such links is to copy and paste-link them one-at-a-time.
  4. Even “automatic” updating of links sometimes fails, with repeated pounding of the F9 key having no affect. In these cases, it’s useful to open the Links window, select all the links, and force an update. (To open the window, the “Edit Links” command needs to be available on one of the ribbons.  It can be added through the “customize the ribbon” dialog.)  This tool is absolutely necessary to make OLE hammocks even slightly bearable.
  5. Resource leveling of linked hammocks can result in unintended consequences. Although most of these can be corrected by a forced update of the links, some changes require that the hammock task be reconstructed.  E.g. removing leveling splits.  The safest course is to assign a priority of 1000 to all linked hammock tasks, thereby exempting them from any leveling actions.

MSP Alternate Hammocks

An alternate approach to hammocks in MSP involves the following steps:

  1. Create the proposed hammock task as either a Fixed Units or Fixed Work task, depending on the nature of the resource loading required.
  2. Specify two predecessors to the proposed hammock task: one Start-to-Start and one Finish-to-Finish, without lags. (These are the same tasks that would otherwise be the sources of the Start and Finish paste-links. Here they are visible and auditable. Do Not paste links.)
  3. Avoid specifying any successors to the hammock.
  4. Create a custom flag field named “Hammock,” and assign a value of “Yes” to the Hammock flag for this task.
  5. Adjust the duration of the task such that it spans between the associated start and finish predecessor dates. (This is done automatically with the macro code below.)
  6. Ensure that the task is assigned a Priority of 1000, which prevents it from being resource-leveled. (This is done automatically with the macro code below.)
  7. Load indirect resources to the task as appropriate.

This alternate approach has the key benefit of presenting an explicit logical basis for the hammock task’s schedule dates, which can be easily checked and modified if necessary.  It also supports the use of Fixed-Work hammocks for allocation of fixed contract costs.  While this alternate approach is no more robust than OLE hammocks when summarizing tasks with potential concurrency, it is far easier to review, modify, and update the associated hammock links when the controlling activities change.

The macro/vba code below is intended to automatically update the durations of all hammock tasks in the active project.  It also automatically removes constraints on hammocks and assigns a priority of 1000 to prevent resource leveling.

This macro/vba code comprises a subroutine and a custom function that should be pasted together into a single module in Visual Basic for Applications.  The “UpdateHammocks” macro may then be assigned to a “hotkey” or ribbon command as appropriate.

[Edit March 2018.  Our MSP add-in, BPC Logic Filter, excludes Hammocks constructed using this method from Longest-Path and Near-Longest-Path reports.  This satisfies the requirement that such tasks not be included in any calculations of the project’s Critical Path.  Since some users have reported inadvertent introduction of splits into hammock tasks during cost updating, I added a little mini-procedure to close all such splits that are 100% in the future, prior to updating the hammock duration.  I also updated the duration calculator to accommodate an assigned resource with a non-standard calendar.  ]

Sub UpdateHammocks()
'15Sep'17 coded by TM Boyle, PSP.
'A code to routinely update the Durations of unlinked, user-managed "hammock" tasks in Microsoft Project.
'A "hammock" task is an indirect/support task that may be resource loaded.  Its schedule
'depends solely on the tasks that it supports/summarizes.
'For this code to work:
'   - All hammock tasks are coded using a custom Flag field (named "Hammock"); Alternately Flag1 is assumed.
'   - Each hammock task has exactly one or two predecessors:
'       - The "Start" predecessor has a Start-to-Start relationship with no lag
'       - The "Finish" predecessor has a Finish-to-Finish relationship with no lag
'       - If there is only one predecessor, then both start and finish of the hammock will come from it.
'   - Each hammock should have NO successors, although this condition is not enforced.
'       - Successors on the hammock can synthetically lengthen the backward path to its "Start" predecessor,
'           thereby reducing Total Slack in that predecessor and its driving chain.
'[21Mar'18 added code to remove splits in hammocks.]
'[22Mar'18 added code for hammock scheduling using a single resource calendar.]


Dim t As Task
Dim d As TaskDependency
Dim StartH As Date
Dim FinishH As Date
Dim i As Integer 'Added 21Mar'18
        
If Not HammockFieldExists Then
    MsgBox ("Couldn't find a Hammock Flag. Aborting")
    Exit Sub
Else
    'Proceed
End If


For Each t In ActiveProject.Tasks
    If Not t Is Nothing Then
        
        StartH = 0
        FinishH = 0
        If t.GetField(FieldNameToFieldConstant("Hammock")) = "Yes" Then
        'If t.Flag1 = True Then 'Flag1 is used to designate Hammock Activities
        
            'Added 21Mar'18
            'First Close Splits if any
            On Error GoTo 0
            If "Proceed" = "Proceed" Then '(change second "Proceed" to another word to bypass for troubleshooting)
                Do While t.SplitParts.Count > 1
                    i = t.SplitParts.Count
                    'Don't remove any splits that begin in the past
                    If ActiveProject.StatusDate < ActiveProject.ProjectFinish Then 'StatusDate Exists
                        If t.SplitParts(i - 1).Finish < ActiveProject.StatusDate Then Exit Do
                    Else ' Use now date
                        If t.SplitParts(i - 1).Finish < Now() Then Exit Do
                    End If
                        t.SplitParts(i).Start = t.SplitParts(i - 1).Finish
                Loop
            End If
            
            If t.PredecessorTasks.Count = 2 Or t.PredecessorTasks.Count = 1 Then
                For Each d In t.TaskDependencies
                    If d.To = t Then
                        If d.Type = pjFinishToStart Or d.Type = pjStartToFinish Then
                            MsgBox ("Hammocks may only have SS or FF predecessors (Check predecessors): " & t.ID & " " & t.Name)
                        Else
                            If d.Type = pjStartToStart Then StartH = d.From.Start
                            If d.Type = pjFinishToFinish Then FinishH = d.From.Finish
                            If t.PredecessorTasks.Count = 1 Then
                                If StartH = 0 Then StartH = d.From.Start
                                If FinishH = 0 Then FinishH = d.From.Finish
                            End If
                            If d.Lag <> 0 Then MsgBox ("Hammocks should not have lag (Check lag): " & t.ID & " " & t.Name)
                        End If
                    Else
                        MsgBox ("Hammocks should not have successors (Check successors): " & t.ID & " " & t.Name)
                    End If
                Next d
            
                    On Error Resume Next
                        t.Duration = Application.DateDifference(StartH, FinishH, t.CalendarObject)
                        If Err.Number <> 0 Then
                            Err.Clear
                            'Added 22Mar'18 - allow for resource calendar controlling task schedule
                            t.Duration = Application.DateDifference(StartH, FinishH, t.Assignments(1).Resource.Calendar)
                            If Err.Number <> 0 Then
                                Err.Clear
                                t.Duration = Application.DateDifference(StartH, FinishH)
                                If Err.Number <> 0 Then
                                    MsgBox ("Failed to update Hammock (Check predecessors): " & t.ID & " " & t.Name)
                                End If
                            End If
                        End If
                        If Err.Number = 0 Then
                            t.Priority = 1000
                            t.ConstraintType = 0
                        End If
            Else
                MsgBox ("There must be 1 or 2 predecessors for this hammock activity. Not Updating: " & t.ID & " " & t.Name)
                
            End If
        End If
    End If
Next t
Application.CalculateProject


End Sub


Function HammockFieldExists() As Boolean
    Dim StrTest As String
    Dim FlagTemp As String

    StrTest = "Hammock"
    On Error Resume Next
        FlagTemp = ActiveProject.ProjectSummaryTask.GetField(FieldNameToFieldConstant(StrTest))
    If Err.Number = 0 Then 'The fieldname exists and will be used
        HammockFieldExists = True
    Else
        HammockFieldExists = False
    End If
End Function

Macro for Tracing, Filtering, and Sorting Task Paths in Microsoft Project

Here are three macros (collectively called QuickTrace) to display the logical predecessors or successors (or both) of the selected task – filtering out all others – and sorted by logical path.  The filter can be limited to show all logic or only “driving” logic.  There is also a highlight-only option.

With the apparent demise of Mike Dahlgren’s site, masamiki.com, his “Trace” macro seems to no longer be generally available.  (It’s also a violation of his site’s terms of use to re-distribute code that was obtained there.)  My entry on Listing Driving Predecessors has been getting a lot of traffic from people who (I suspect) are trying to find a variation of Trace.  In response to a question over at MPUG today, I decided to write up something – what I call QuickTrace – to generate similar output for sharing.  It is after all less than a hundred lines of code.

For determining driving relationships, QuickTrace relies on MSP’s “StartDriver” task object, the basis of the Task Inspector pane (and the Driving Predecessors highlighter in MSP 2013+).  This is a substantial improvement over the original Trace macro, which used Free Slack as the driving indicator.  Still, I’ve found StartDriver to be unreliable in the presence of non-FS relationships (See here.)  BPC Logic Filter (our MSP Add-In) instead identifies driving relationships directly by computing and examining relationship free floats – quite a bit more involved.

[Jan’19 Edit: QuickTrace also relies on recursion (a sort of repeated self-cloning process), and this makes it susceptible to crashing if the path length (in number of tasks) is too long.  In MSP 2010, I’ve analyzed path lengths a bit over 4,000 tasks before crashing.  The same analysis in MSP 2016 leads to a crash after only 700 tasks.

Version 1.5 of BPC Logic Filter now includes a QuickTrace option.

This implements the same recursive tracing algorithm that I’ve included in the macro code.  It’s blazing fast, and its results are perfectly aligned with the Task Path bar styles of MSP 2013+, no matter how flawed.  It also handles much longer path lengths (just under 8,000 tasks in MSP 2016) before running out of memory.]

Here’s the code. There are basically three front-end macros that you can assign buttons or hot keys to, one for predecessor chains, one for successor chains, and one for both.  (Using the last one can make the resulting path sort a little jumbled, so I made re-sorting optional.)    These call the other procedures to a) collect user input; b) clear existing values in the Flag4 and Number5 fields; c) recursively run through the chains of related tasks and and mark them using those fields; d) apply the filter and sort using those fields; and e) display a message box summarizing the filter/highlighting.  Note, this is provided as-is and is not supported by anyone.  I have not taken the time to accommodate every possible situation and won’t be doing so in the future.  If you are new to vba, please google around a bit before asking questions that are already answered somewhere else – that includes, “how do I install this and make it work?”  (Short answer: copy and paste the entire block into a new module in the visual basic editor.  Then add the three front-end macros to a custom group on one or more of your ribbon tabs.)

'QuickTrace Module
'Coded by T.Boyle, PE, PSP on 16Mar'17 [25Sep'18 edits - to allow highlighting, to provide a descriptive message box
'   after running, and to streamline the code.]  This Module is intended to trace logical paths from the selected task
'   to all of its predecessors or successors, then show only related tasks.  Tasks are sorted in the order of analysis,
'   which generally corresponds to identified logical "paths".
'CAVEATS:
'   1. This code WILL OVER-WRITE fields FLAG4 and NUMBER5.  Make sure these fields are not needed before running.  Otherwise,
'      edit the code to use different fields, as shown below.
'   2. This code relies on the StartDriver object for defining driving path logic.  It may not always be reliable for non FS
'      relationships.
'   3. Install all code into a new module, with "QuickTrace Module" above as the top line.
'   4. Assign buttons or hotkeys to the first three procedures only (the others are called by these three):
        'a. CallQTraceP() - Traces predecessors.
        'b. CallQTraceS() - Traces successors.
        'c. CallQTraceB() - Traces both predecessors and successors (Added 15Nov'17)
'
 
Option Explicit
Private Cnt As Long, Driv As Boolean, HL As Boolean, ShowSums As Boolean, Tsel As Task, DirGlob As String
 
Sub CallQTraceP()
    'This procedure finds, marks, filters, and sorts predecessors of the selected task.
    'Run this directly using a button or hot key
     
    Cnt = 0
    DirGlob = "P"
        
    ClearFields
    CollectInput
    'Run Trace from Selected cell
    Call QTrace(Tsel, "P")
    Call Filter("P")
 
End Sub
 
Sub CallQTraceS()
    'This procedure finds, marks, filters, and sorts successors of the selected task.
    'Run this directly using a button or hot key
     
    Cnt = 0
    DirGlob = "S"
        
    ClearFields
    CollectInput
    'Run Trace from Selected cell
    Call QTrace(Tsel, "S")
    Call Filter("S")
 
End Sub
 
Sub CallQTraceB()
    'This procedure finds, marks, filters, and sorts both predecessors and successors of the selected task.
    'Run this directly using a button or hot key
     
    Cnt = 0
    DirGlob = "B"
        
    ClearFields
    CollectInput
    'Run Trace from Selected cell
    Call QTrace(Tsel, "P")
    Call QTrace(Tsel, "S")
    Call Filter("P")
 
End Sub
 
Sub QTrace(ByRef t As Task, ByVal dir As String)
    'This procedure marks a task (as related) and calls itself for each related predecessor or successor.
    'This procedure is called by another procedure.
     
    Dim d As TaskDependency
    Dim ds As TaskDependency
     
    'Mark this task as related
    Cnt = Cnt + 1
    '''''''''''''''''''''''''''''''''''''''''''''Edit Fields Flag4 and Number5 as Needed'''''''''''''''''''''''''''''''''''''''''
    t.Flag4 = True
    t.Number5 = Cnt
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
    'Recurse to next dependency
    If Driv Then
        If dir = "P" Then
            For Each d In t.StartDriver.PredecessorDrivers
                Call QTrace(d.From, "P")
            Next d
        Else 'i.e. dir="S"
            For Each ds In t.TaskDependencies
                If ds.From = t Then
                    For Each d In ds.To.StartDriver.PredecessorDrivers
                        If d.From = t Then Call QTrace(d.To, "S")
                    Next d
                End If
            Next ds
        End If
    Else
        For Each d In t.TaskDependencies
            If dir = "P" And d.To = t Then Call QTrace(d.From, "P")
            If dir = "S" And d.From = t Then Call QTrace(d.To, "S")
        Next d
    End If
End Sub
 
Sub CollectInput()
    'This procedure collects user input.
    'This procedure is called by another procedure.

    Driv = False
    HL = False
    ShowSums = False
    
    Set Tsel = ActiveCell.Task
    If MsgBox("Driving Path only?", vbYesNo) = vbYes Then Driv = True
    If MsgBox("Highlight only?", vbYesNo) = vbYes Then
        HL = True
    Else
        If MsgBox("Show Summary Tasks?", vbYesNo) = vbYes Then ShowSums = True
    End If

End Sub
Sub ClearFields()
    'This procedure runs through the tasks of the active project and clears two selected fields for use.
    'This procedure is called by another procedure.
     
    Dim t As Task
    'Clear Fields
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
    '''''''''''''''''''''''''''''''''''''''''''''Edit Fields Flag4 and Number5 as Needed'''''''''''''''''''''''''''''''''''''''''
            t.Flag4 = False
            t.Number5 = 0
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        End If
    Next t
End Sub
 
Sub Filter(ByVal dir As String)
    'This procedure creates and applies a filter to show only related tasks.
    'This procedure is called by another procedure.
     
            '''''''''''''''''''''''''''''''''''''''''''''Edit Field Flag4 as Needed'''''''''''''''''''''''''''''''''''''''''
            FilterEdit Name:="Flag4", TaskFilter:=True, Create:=True, _
                OverwriteExisting:=True, FieldName:="Flag4", Test:="equals", _
                Value:="Yes", ShowInMenu:=True, ShowSummaryTasks:=ShowSums
            FilterApply Name:="Flag4", Highlight:=HL
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        
        If ShowSums Then '(HL is False)
            'Sort by path order
            If MsgBox("Resort to show paths?", vbYesNo) = vbYes Then
            '''''''''''''''''''''''''''''''''''''''''''''Edit Field Number5 as Needed'''''''''''''''''''''''''''''''''''''''''
                If dir = "P" Then Sort Key1:="Number5", Ascending1:=False, Renumber:=False, Outline:=True
                If dir = "S" Then Sort Key1:="Number5", Ascending1:=True, Renumber:=False, Outline:=True
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            End If
        Else '(ShowSums is False and HL may be true or false)
            If Not HL Then
            'Sort by path order
                If MsgBox("Resort to show paths?", vbYesNo) = vbYes Then
            '''''''''''''''''''''''''''''''''''''''''''''Edit Field Number5 as Needed'''''''''''''''''''''''''''''''''''''''''
                    If dir = "P" Then Sort Key1:="Number5", Ascending1:=False, Renumber:=False, Outline:=False
                    If dir = "S" Then Sort Key1:="Number5", Ascending1:=True, Renumber:=False, Outline:=False
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                End If
            End If
        End If
        EditGoTo ID:=Tsel.ID
        FilterBox
End Sub
        
Sub FilterBox()
    'This procedure creates and displays a message box describing the filter/highlight basis.
    'This procedure is called by another procedure.
    Dim Msg As String
    
    If HL Then
        Msg = "Highlighting "
    Else
        Msg = "Filtering for "
    End If
    
    Select Case DirGlob
        Case "P"
            If Driv Then Msg = Msg &amp;amp;amp; "driving "
            Msg = Msg &amp;amp;amp; "predecessors "
        Case "S"
            If Driv Then Msg = Msg &amp;amp;amp; "driven "
            Msg = Msg &amp;amp;amp; "successors "
        Case "B"
            If Driv Then Msg = Msg &amp;amp;amp; "driving &amp;amp;amp; driven "
            Msg = Msg &amp;amp;amp; "predecessors &amp;amp;amp; successors "
    End Select
    
    Msg = Msg &amp;amp;amp; "of task " &amp;amp;amp; Tsel.ID &amp;amp;amp; ": " &amp;amp;amp; Tsel.Name &amp;amp;amp; " (inclusive)"
    MsgBox Msg
    
End Sub


[Aug’18 Edit:] One of the commentators sent an example of a schedule where the macro includes in the driving path to project completion two tasks that are in fact neither critical nor driving .  As shown below, the Task Path functionality is used to highlight the “Driving Predecessors” to Task 13 (orange bars).

Tasks 21 and 22 are included in the Task Path highlighting, and they are also flagged as part of the Driving Path (to Task 13) by the QuickTrace macros.  This is because MSP has marked Task 22 as the StartDriver predecessor for Task 26.  As a manually-scheduled task, however, Task 26 really has NO StartDriver predecessor, and the reference to Task 22 is incorrect.  Neither the macro nor the Task Path function has been adapted to account for this.  (BPC Logic Filter correctly excludes these non-driving tasks, and MSP marks them as non-critical because they possess positive Total Slack.)

Simple Macro for Imposing Zero Free Float Constraints in Microsoft Project

Here I outline a method – including the ImposeZFF macro – to provide “just-in-time” scheduling of flagged tasks in MSP.  I also include a separate macro, RemoveZFF, to restore the tasks to as-soon-as-possible scheduling.

Another missing feature for anyone coming to MSP from Primavera’s planning tools is the “Zero Free Float (ZFF)” constraint.  (Primavera now calls this the “As Late as Possible (ALAP)” constraint – NEVER to be confused with MSP’s identically-named version, which is pretty useless for forward scheduling.)  The ZFF constraint delays an activity as much as possible without impacting any successor activities.  It is useful for scheduling just-in-time works and deliveries while preserving the correct logic flow through the project schedule.

Consider the simple project shown here.  The overall project completion is limited by a constraint on task B.  (I never use such mandatory constraints in practice but use it here to avoid having to add other extraneous logic to the example.)  Task A must be completed before B, but for maximum efficiency it is desired to perform this work just-in-time.  Because MSP has no other obvious feature to arrive at the desired schedule outcome, the scheduler is tempted to make task A a Start-to-Finish successor of B.  Such an approach is unsound and is to be avoided for a number of reasons.  All links in a logic-driven project schedule must reflect real logical constraints, and real Start-to-Finish constraints are extremely rare.

ZFF1a

So what is the scheduler to do?  Most situations are easily solved by adding logical milestones to the project schedule.  For example, a logic-driven “Site Ready for Delivery” milestone as a Finish-to-Finish predecessor of “Eqpt Delivery” would be quite normal.  In the very few occasions when suitable logical workarounds cannot be devised, then it may be useful to impose early-start constraints to achieve the zero-free-float objectives.  For good control over the process, I use a custom flag field to designate specific tasks requiring ZFF constraints.  Then I run a macro that automatically computes and assigns the appropriate constraint to all the ZFF tasks in the project at once.  This makes ZFF constraints easy to audit, review, and justify.

For our simple project example, I inserted the Flag20 local field into the Gantt Chart entry table and called it ZFF.  Then I marked task A with the ZFF flag and ran the macro.  The macro automatically imposed a new early-start constraint on the task.  As a result, the 12 days of Total Slack (like the 12 days of Free Slack) that previously existed have been consumed.  Task A is now correctly shown as Critical.ZFF2a

If your project has a logical chain of tasks that are all ZFF-flagged, then you’ll have to re-run the macro several times (or add a simple iteration loop to the code.  I have one but didn’t include it here for simplicity.)

The code for imposing the constraints is shown below.  Drop it into a VBA module in your Global.mpt file (or in a specific .mpp file if necessary), then look for and run macro “ZFFImpose”.  I normally use another function to find the ZFF flag field in a project, but that function was too big to include here.  So if you want to use a custom flag field other than Flag20, just change the “FieldName = “Flag20″” statement in the code.

Sub ZFFImpose()
' Macro Coded 31-08-16 by Thomas Boyle PE PSP PMP.
On Error GoTo 0
    
    Dim i As Integer
    Dim t As Task
    Dim L1 As String
    Dim L2 As String
    Dim SW1 As Boolean
    Dim SW2 As Boolean
    Dim SW3 As Boolean
    Dim FieldName As String
    
    'FieldName = FindField_Flag("ZFF") 'Function not included here
    Fieldname="Flag20"
    If FieldName = "" Then
        MsgBox Prompt:="No ZFF Flag Field Found", Title:="ZeroFreeFloat Constraints"
        Exit Sub
    End If
                
    CalculateProject

        For Each t In ActiveProject.Tasks
            If Not t Is Nothing Then
                If t.GetField(Application.FieldNameToFieldConstant(FieldName)) = "Yes" Then
                    If t.FreeSlack > 0 Then
                        t.ConstraintType = pjSNET
                        If t.Calendar = "None" Then
                            t.ConstraintDate = Application.DateAdd(t.Start, t.FreeSlack)
                        Else
                            t.ConstraintDate = Application.DateAdd(t.Start, t.FreeSlack, t.CalendarObject)
                        End If
                        CalculateProject
                        L1 = L1 & t.ID & " " & t.Name & " " & t.ConstraintDate & vbCrLf
                        SW1 = True
                    Else
                        L2 = L2 & t.ID & " " & t.Name & vbCrLf
                        SW2 = True
                    End If
                End If
            End If
        Next t
    GoTo Finish

tEHandler:
    MsgBox ("Failed to impose Zero Free Float Constraints")
    Exit Sub
    
Finish:
    CalculateProject
    If SW1 = True Then MsgBox Prompt:="Imposed Early Start Constraints to remove free float:" & vbCrLf & L1, Title:="ZeroFreeFloat Constraints"
    If SW2 = True Then MsgBox Prompt:="No free float to remove on tasks: " & vbCrLf & L2, Title:="ZeroFreeFloat Constraints"
    If SW1 = False And SW2 = False Then MsgBox Prompt:="No tasks marked for ZFF", Title:="ZeroFreeFloat Constraints"
    
End Sub

What is done with the “ZFFImpose” macro is easily undone with the “ZFFRemove” macro shown below.  This macro returns all ZFF-flagged tasks to “As Early As Possible” scheduling.

Sub ZFFRemove()
' Macro Coded 31-08-16 10:30 by Thomas Boyle PE PSP PMP.
On Error GoTo 0
    
    Dim t As Task
    Dim L1 As String
    Dim SW1 As Boolean
    Dim FieldName As String
    
    FieldName = "Flag20"
    'FieldName = FindField_Flag("ZFF")
    If FieldName = "" Then
        MsgBox Prompt:="No ZFF Flag Field Found", Title:="ZeroFreeFloat Constraints"
        Exit Sub
    End If
                
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
            If t.GetField(Application.FieldNameToFieldConstant(FieldName)) = "Yes" Then
                If t.ConstraintType = pjSNET Then
                    t.ConstraintType = pjASAP
                    CalculateProject
                    L1 = L1 & t.ID & " " & t.Name & vbCrLf
                    SW1 = True
                End If
            End If
        End If
    Next t
    GoTo Finish

tEHandler:
    MsgBox ("Failed to remove Zero Free Float Constraints")
    Exit Sub
    
Finish:
    CalculateAll
    If SW1 = True Then MsgBox Prompt:="Removed Early Start Constraints from designated ZFF tasks:" & vbCrLf & L1, Title:="ZeroFreeFloat Constraints"
    If SW1 = False Then MsgBox Prompt:="No tasks marked for ZFF", Title:="ZeroFreeFloat Constraints"
End Sub

 

Simple Macro for Computing (Duration) Drag in MS Project

Here is the BFDDrag macro, which implements a brute-force technique to compute Critical Path Drag for all tasks in the active project.

Drag and Drag cost are two useful metrics in CPM scheduling that Stephen Devaux introduced in his book Total Project Control, but they are not widely computed or used.  Drag – coined as “Devaux’s Removed Activity Guage,” represents the individual contribution of any single schedule element (e.g. a task) to the overall duration of a project.  By definition, only “Critical Path” tasks have it, and a task’s Drag indicates the total theoretical project acceleration that could be gained if the task’s remaining duration were reduced to zero.  (Duration is not the only contributor to Drag – consider predecessor lags and constraints – but it is certainly the most prevalent.)

Drag can be useful in prioritizing activities for crashing (i.e. shortening) a project schedule.  Consider the simple project illustrated in Figure 1.  The “Critical Path” (ACFIJ – dark-red bars) is partially flanked by a near-critical path (BEH – hatched red bars) with a relative float (same as total slack here) of 2 days.  The overall project duration can be shortened by accelerating critical-path tasks, and most experienced schedulers would be tempted to first consider modifying the two longest critical tasks (C and I).  Accelerating either of them by more than two days yields no benefit, however, as the near-critical path then becomes Critical.  Drag indicates this limit for each task – not so obvious in complex project schedules – in advance.

Figure 1: NLD59DRAG1
Figure 1: Simple Drag Example

Below is a simple, brute force, macro for computing task drag (i.e. the drag of it’s duration) in Microsoft Project. The procedure cycles through each task in the project. If the task is a non-summary, incomplete task that is marked “Critical”, then the procedure sets its remaining duration to zero and measures the resulting acceleration (if any) of the project finish date. That value is stored in the Custom Field – “Duration5” as DRAG.  You’ll have to change this in the macro if “Duration5” is already in use.  I’ve also included a few comments in the code to guide you in modifying its scope.  The procedure is logged in the “Immediate” window of the Visual Basic editor.  After running this macro, Drag Cost could be separately computed for each task using a custom field formula that references the value in “Duration5”.

As noted, this is a “Brute Force” approach that relies on repetitive re-calculation of the CPM network by MSP’s scheduling engine.  At two calculation cycles for each critical task, it may take a long time to chug through a very large project, but it will get there eventually.  If your schedule has negative Total Slack, then MSP may interrupt the procedure to pop up a schedule warning window that you will need to click through (I have not added code to turn this warning off, but you can if you want).  This warning window may not always be visible if MSP is not the active application – you’ll need to click on it occasionally.


Sub BFDDrag()

'       Coded by Thomas Boyle, PE, PMP, PSP on 8Jan'16
'       This is a simple brute-force procedure to compute Duration DRAG (Devaux's Removed Activity Guage") for
'       each Critical task in the active project.  The procedure cycles through each task in the project.  If the task
'       is a non-summary, incomplete task that is marked "Critical", then the procedure sets its duration to zero and
'       measures the resulting acceleration (if any) of the project finish date.  That value is stored in the Custom
'       Field - "Duration5" as DRAG.  The procedure is logged in the "Immediate" window of the Visual Basic editor.

    Dim Tsk As Task, ODur As Double, OFin As Date, TDrag As Double
    Dim StartNote As String
    Dim Counter As Long
        
    Application.CalculateProject
    StartNote = ActiveProject.Name & vbCrLf & Now() & " Starting Drag Brute Force" & vbCrLf
    Counter = 0
        Debug.Print StartNote
    'OFin is the finish date to be tested.  Default is the Project Finish.
    OFin = ActiveProject.ProjectFinish
    
    'Default computes DRAG for each task in ActiveProject.  To compute only for selected tasks,
    'then change "ActiveProject.Tasks" to "ActiveSelection.Tasks"
    For Each Tsk In ActiveProject.Tasks
        If Not Tsk Is Nothing Then
            If Tsk.Summary = False And Tsk.PercentComplete <> 100 Then
                Tsk.Duration5 = 0
                Counter = Counter + 1
                Debug.Print Counter & "Checking Task: " & Tsk.ID & " " & Tsk.Name
                
                If Tsk.Critical = True Then
                    If Tsk.Duration > 0 Then
                        ' Remove Task Duration and Check Finish Date
                        ODur = Tsk.Duration
                        Tsk.Duration = Tsk.ActualDuration
                        Application.CalculateProject
                        If Application.DateDifference(ActiveProject.ProjectFinish, OFin) > 0 Then  'Decreasing Normal Critical case
                            TDrag = Application.DateDifference(ActiveProject.ProjectFinish, OFin)
                        Else    'Decreasing Neutral or Reverse Critical case (Zero Drag)
                            'Test for Increasing Reverse Critical Case
                            Tsk.Duration = ODur + 1 'Adding one minute to Duration
                            Application.CalculateProject
                            If Application.DateDifference(ActiveProject.ProjectFinish, OFin) > 0 Then
                                'Increasing Reverse Critical case
                                TDrag = -1 * 5 'INDICATOR ONLY. Need further testing to find limit
                            Else
                                TDrag = 0
                            End If
                        End If
                        Debug.Print "Drag = " & TDrag / 60 / ActiveProject.HoursPerDay & "Days"
                        Tsk.Duration5 = TDrag
                        Tsk.Duration = ODur
                        Application.CalculateProject
                    End If 'Positive Duration

                Else
                    Debug.Print "Non-Critical"
                End If 'Critical Task Check DRAG
            End If 'Summary=No
        End If 'Not Nothing
    Next Tsk
    
    Debug.Print "Previous: " & StartNote
    Debug.Print Now(), "Finished Drag Brute Force"

End Sub

I started to include Lag Drag in the procedure, but modifying the lag value through code is a little more complicated.  That will have to wait for another time.

I originally wrote a version of this brute-force macro to test the performance of the drag computations in BPC Logic Filter.  Unfortunately, although BPC Logic Filter runs much, much faster for larger networks, it can fail to catch the Drag limitations caused by early start constraints and task calendar changes away from a given task.  This simple macro is still the standard (for incomplete tasks).

[20Jan’16 – Edited code to catch “negative” drag for “reverse-critical” tasks.  These are rare critical-path tasks that include a reverse flow of driving logic.

22Jan’16 – Further code edit to zero-out negative drag for all except the singular case where increasing task duration shorten’s the project.  In that case, the code leaves a value of -0.01 days as an indicator only.]

[This macro computes Drag only with respect to the overall completion of the active project, not any specific completion milestone, and it uses the active project’s default calendar for quantifying Drag.  If your true Critical Path is defined by some completion milestone that is not the last task in the project, then you will need a more powerful tool.  This video demonstrates Drag calculation in BPC Logic Filter.]

 

Simple Macro for Listing Driving Predecessor(s) in MS Project

The Drivers macro reads and copies the ID of each task’s driving predecessors into a custom text field for the task.

One of the missing features for anyone coming to MSP from Primavera’s planning tools is the little mark designating the driving predecessor(s) in the predecessors list for each activity.

MS Project 2010+ kind of addresses this with a feature called “Task Inspector” that opens a pane and displays some scheduling factors affecting the selected task.  One of the factors displayed is the “Predecessor Tasks:” table, which lists the predecessor(s) (if any) that limit the early start date of the selected task.  The driving predecessor is inserted as a link, so it is possible to jump through the driving logic of the schedule.

Since I use BPC Logic Filter, I haven’t had much use for Task Inspector.  Still, it is occasionally useful to see a long list of predecessors and know immediately which ones are driving the selected task.  Here is a little macro to copy the IDs of the driving predecessors into the “Text2” field of each task.

Sub Drivers()

    Dim t As Task
    Dim td As TaskDependency
    Dim PredDr As String
    Dim i As Integer
    
    
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
            PredDr = ""
            i = 0
        
            For Each td In t.StartDriver.PredecessorDrivers
                i = i + 1
                If i = 1 Then
                    PredDr = PredDr & td.From.ID
                Else
                    PredDr = PredDr & "," & td.From.ID
                End If
            Next td
            
            t.Text2 = PredDr
        End If
    Next t

End Sub

The user can then insert the “Text2” column in any task view.  The image at the top of the post is a little schedule with the column inserted as shown and named “Driving Pred”.

The “Drivers” determination is done by MSP’s scheduling engine, and I have found it to be unreliable for driving predecessors that are not Finish-to-Start links.  (Problems-with-predecessor-tasks-in-task-inspector)  Nevertheless, it’s better than nothing.  Obviously, the macro needs to be re-run whenever the logic or task numbering changes….

If you are interested in a real logic trace of the driving path for the activity, then you’ll need a much more sophisticated macro (like this one) or a full-fledged Add-In like BPC Logic Filter – shown in this video.    As a side feature, BPC Logic Filter includes a task Logic Inspector that displays driving and non-driving relationships for any task.  Visit the Download Page to get a fully-functioning Trial version.