' A little Macro which fans out predecessors, successors or both depending on the user input
' This macro works best if assigned to a button on your toolbar
' Uses Flag5 to store information - please be sure that this field is not currently in use
' Note: Does not work with Inserted/Consolidated projects as it does not handle external tasks
' Jack Dahlgren, Jan 11, 2001
' Do not redistribute without Author's Permission
' No guarantee of performance or suitability for any purpose
' Use only on files which have been backed up
' RELEASE HISTORY
' Version 1.2, Jan 11, 2001 - Added ability to show only driving/driven
' activities (FreeSlack = 0)
' Version 1.1, Jan 05, 2001 - Added ability to show critical items only,
' simplified ClearFlags
' Version 1.0, June 19, 2000 - Original version
' To Do: enable multiple traces by setting ClearFlags
' Work out trace through external tasks
Option Explicit
Dim Forward As Boolean
Dim SelectedID As Integer
Dim jString As String
Dim IsSum As Boolean
Dim IsCrit As Boolean
Dim IsDrive As Boolean
Dim jTask As Task
'This is the master macro
Sub Trace()
If ActiveSelection = 0 Then
MsgBox "You must have just one task selected for this macro to work"
Exit Sub
End If
If ActiveSelection.Tasks.Count <> 1 Then
MsgBox "You must have just one task selected for this macro to work"
Exit Sub
End If
'This sets flag used later for tracing paths.
jString = InputBox(("Please Enter Fan Type" & Chr(13) & Chr(13) & "P (Predecessors)" & Chr(13) & "S (Successors)" & Chr(13) & "A (All)"), "Fan-out Dependencies")
jString = UCase(Left(jString, 1))
If jString = "" Then
Exit Sub
End If
ClearFlags
IsCrit = False
For Each jTask In ActiveSelection.Tasks
If jTask.Summary = True Then
MsgBox "You have selected a summary task. Select a taks or milestone and try again"
Exit Sub
End If
If jTask.Critical = True Then
If MsgBox("Do you want to display only Critical Tasks?", 260, "Display Critical Tasks Only?") = vbYes Then
IsCrit = True
End If
End If
Next jTask
'This sets the flag for 0 free float (driving) tasks
IsDrive = False
For Each jTask In ActiveSelection.Tasks
If IsCrit = False Then
If MsgBox("Do you want to display only Driving Tasks?", 260, "Display Driving Tasks Only?") = vbYes Then
IsDrive = True
End If
End If
Next jTask
Select Case jString
Case "P"
TracePredecessors
Case "S"
TraceSuccessors
Case Else
TraceAll
End Select
FilterMe
If SelectedID > 0 Then Find Field:="ID", Test:="equals", Value:=SelectedID, Next:=True
End Sub
' Set all tasks Flag5 to false
Private Sub ClearFlags()
Dim jTask As Task
For Each jTask In ActiveProject.Tasks
If Not (jTask Is Nothing) Then
If jTask.Flag5 = True Then jTask.Flag5 = False
End If
Next jTask
End Sub
' Traces Only Successor Tasks - forward equal to true
Private Sub TraceSuccessors()
SelectedID = 0
Forward = True
MarkItem
End Sub
' Traces Only Predecessor Tasks - forward equal to false
Private Sub TracePredecessors()
SelectedID = 0
Forward = False
MarkItem
End Sub
' Traces All Tasks - one pass for successors, then one for predecessors
Private Sub TraceAll()
SelectedID = 0
Forward = True ' mark successors
MarkItem
Forward = False ' mark predecessors
MarkItem
End Sub
' Marks all tasks feeding by selected task(s)
Private Sub MarkItem()
Dim jTask As Task, jjTask As Task
For Each jTask In ActiveSelection.Tasks
If Not (jTask Is Nothing) Then
SelectedID = jTask.ID
If Not (jjTask Is Nothing) Then
If Not Forward Then
Fan jjTask
Else
jjTask.Flag5 = True
End If
If Not (jjTask Is Nothing) Then
If Forward Then
Fan jjTask
Else
jjTask.Flag5 = True
End If
End If
Else
Fan jTask
End If
End If
Next jTask
End Sub
' Walks through all predecessors or successors to a task and marks their flag5 as true
Private Sub Fan(jTask As Task)
Dim jjTask As Task
jTask.Flag5 = True
If Forward Then
For Each jjTask In jTask.SuccessorTasks
If jjTask.Flag5 <> True Then
If IsCrit And Not IsDrive Then
If jjTask.Critical = True Then
Fan jjTask
End If
ElseIf IsDrive = True Then
If jjTask.FreeSlack < 100 Then
Fan jjTask
End If
Else
Fan jjTask
End If
End If
Next jjTask
Else
For Each jjTask In jTask.PredecessorTasks
If jjTask.Flag5 <> True Then
If IsCrit And Not IsDrive Then
If jjTask.Critical = True Then
Fan jjTask
End If
ElseIf IsDrive = True Then
If jjTask.FreeSlack < 100 Then
Fan jjTask
End If
Else
Fan jjTask
End If
End If
Next jjTask
End If
End Sub
' Filter with or without summary tasks
Private Sub FilterMe()
If MsgBox("Do you want to display Summary Tasks?", vbYesNo, "Display Summary Tasks?") = vbYes Then
IsSum = True
Else: IsSum = False
End If
OutlineShowAllTasks
FilterEdit Name:="_Trace", TaskFilter:=True, _
Create:=True, _
OverwriteExisting:=True, _
FieldName:="Flag5", _
Test:="Equals", _
Value:="Yes", _
ShowInMenu:=False, _
ShowSummaryTasks:=IsSum
FilterApply Name:="_Trace"
End Sub