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.