Miles
Miles

Reputation: 127

MS Project VBA - finding the last row of the last sub project inserted in a master project

I have a simple Master plan with 3 inserted small plans as a prototype for a much larger and more complex project. I want to find out what the value in Text1 is for the last item in the master / sub project plan. I have a macro which links up dependencies across the sub plans based on a unique reference - loop through the tasks, when you find a reference loop through all the tasks again to find a match and build the dependency link. This works brilliantly unless there isn't a matching reference in the plan (for instance when there is an external dependency which doesn't appear in the sub plans). At this point it just links to the last item that it found which is not good.
To get around this I have established how many rows there are in the plan and will ignore anything which is returned at the end of the "sub search" ''''

For Each t In ActiveProject.Tasks
    If t Is Nothing Then
        'do nothing
    Else
        If LCase(t.Text1) = LCase("Dep_in") Then
            ref = t.Text2
            n = 0
            For Each t_check In ActiveProject.Tasks
                n = n + 1
                If t_check Is Nothing Then
                    'do nothing
                Else
                    If LCase(t_check.Text2) = LCase(ref) And LCase(t_check.Text1) = LCase("Dep_out") Then
                        ID = t_check.ID
                        Source = t_check.Project
                        If n < max_tasks Then t.ConstraintType = pjASAP
                        If n < max_tasks Then t.Predecessors = Dep_path & Source & ".mpp\" & ID
                    End If
                End If
            Next t_check

         End If
    End If

Next t

The issue with this method is that if there is a legitimate Deliverable on the last row of the last sub plan it will never be picked up. Unless there is a neat way to handle the situation where there isn't a match in the sub loop how can I test the lastrow.text1 to see if it contains DEP and if so issue a message warning of this fact? The only way I can think to do this would be the rather inelegant:

n = 0
For Each t In ActiveProject.Tasks
    If t Is Nothing Then
        'do nothing
    Else
        n = n + 1
    End If
Next t
max_tasks = n
n = 0
For Each t In ActiveProject.Tasks
    If t Is Nothing Then
        'do nothing
    Else
        n = n + 1
        If n = max_tasks Then Debug.Print t.Name
    End If
Next t

Thanks

Upvotes: 1

Views: 469

Answers (1)

Rachel Hettinger
Rachel Hettinger

Reputation: 8442

When working with master projects it is important to remember that the Tasks collection only contains the tasks in the master project. In the example posted in the question, ActiveProject.Tasks will contain 3 tasks--one for each of the subprojects.

To loop through all of the tasks, expand the schedule so that all are shown, select all, then loop through the selection.

FilterClear
SelectAll
OutlineShowAllTasks
SelectAll
Set allTasks = ActiveSelection.Tasks

To find the matching task to link, there are at least two options: 1) make a copy of the collection of tasks (allTasks2) and loop through that, or 2) use the Find method.

The Find method shines when looking for a single match in a single field. For example, configure Text3 with a formula that concatenates Text1 and Text2 and this is all that's needed:

If Find("Text3", "equals", t.Text1 & t.Text2) Then
    Set tskOut = ActiveCell.Task
    t.ConstraintType = pjASAP
    t.Predecessors = Dep_path & Source & ".mpp\" & tskOut.ID
End If

However, the Find method can still be used efficiently by knowing that the method moves the active cell to the next match, if found. In this way, the Find method can be used in a loop to find the correct match, or indicate if no match was found. The main body of the code can be reduced to this:

For Each t In allTasks
    If Not t Is Nothing Then
        If LCase(t.Text1) = LCase("Dep_in") Then
    
            Dim tskOut As Task
            Set tskOut = FindDepOutTask(t)
            If tskOut.UniqueID <> t.UniqueID Then
                t.ConstraintType = pjASAP
                t.Predecessors = Dep_path & Source & ".mpp\" & tskOut.ID
            End If
            
        End If
    End If
Next t

Using the helper function:

Function FindDepOutTask(depInTask As Task) As Task

    ' start at Dep In Task
    Find "Unique ID", "equals", depInTask.UniqueID
    Dim tskOut As Task
    Set tskOut = depInTask
    
    Do
        Find "Text2", "equals", depInTask.Text2
        Set tskOut = ActiveCell.Task
    Loop Until tskOut.UniqueID = depInTask.UniqueID Or LCase(tskOut.Text1) = LCase("Dep_out")

    Set FindDepOutTask = tskOut
    
End Function
 

Upvotes: 0

Related Questions