Search code examples
excelvbams-project

Automatically adding subtasks to Microsoft Project from Excel file


So I have an Excel file where each row is a new task in Microsoft Project. The Excel file is refreshed each week with new rows. I used the Project import wizard to map the fields so when I merge the Excel file into Project the mapped fields are updated and new tasks are added when there is a new row in the Excel file.

However, now I need to automatically add three subtasks to each main task in Project after importing the Excel file without replacing the subtasks of the tasks that were already in the file. In other words, I need to automatically add the three subtasks whenever there is a new task in the Project file. Each task in Project have the same three subtasks.

Is there a way I can do this in VBA?

The image below shows how the subtasks should show under each task after you run the script. Tasks 2 to 11 should show those exact three subtasks.

https://i.sstatic.net/fOMrh.jpg

Sub ModifyName()

    Dim tsk As Task
    
    For Each tsk In ActiveProject.Tasks
        If Not tsk Is Nothing Then
            tsk.Name = tsk.Text2 + "-" + tsk.Name
        End If
        
    Next tsk
    
End Sub

Sub InsertSubTask()

    For Each tsk In ActiveProject.Tasks
        If tsk.Flag1 And tsk.OutlineChildren.Count = 0 Then
            With ActiveProject
                .Tasks.Add tsk.Name + " " + "name1", tsk.ID + 1
                .Tasks.Add tsk.Name + " " + "name2", tsk.ID + 2
                .Tasks.Add tsk.Name + " " + "name3", tsk.ID + 3
                
                .Tasks(tsk.ID + 1).OutlineIndent
                .Tasks(tsk.ID + 2).OutlineIndent
                .Tasks(tsk.ID + 3).OutlineIndent
                
                .Tasks(tsk.ID + 1).Start = tsk.Date1
                .Tasks(tsk.ID + 2).Start = tsk.Date2
                .Tasks(tsk.ID + 3).Start = tsk.Date3
                
                .Tasks(tsk.ID + 1).Number1 = tsk.Number1
                .Tasks(tsk.ID + 2).Number1 = tsk.Number1
                .Tasks(tsk.ID + 3).Number1 = tsk.Number1
                
                
            End With
        End If
    Next tsk
    

    
End Sub

Solution

  • Here's a basic macro that adds subtasks to specific tasks if they don't already have subtasks. For this example, the Flag1 field is used to identify the tasks that should have subtasks. That logic can be easily changed to look at task name, a text field, etc.

    Update: The last block of code sets the Start date for each new task based on dates saved in the flagged tasks' numbered Date fields. (Note that setting the Start date sets a Constraint Type = "Start No Earlier Than" with the Constraint Date equal to what was set as the Start date.)

    Sub InsertSubTasks()
    
        Dim tsk As Task
        For Each tsk In ActiveProject.Tasks
            If tsk.Flag1 And tsk.OutlineChildren.Count = 0 Then
                With ActiveProject
                    .Tasks.Add "Subtask 1", tsk.ID + 1
                    .Tasks.Add "Subtask 2", tsk.ID + 2
                    .Tasks.Add "Subtask 3", tsk.ID + 3
                    
                    .Tasks(tsk.ID + 1).OutlineIndent
                    .Tasks(tsk.ID + 2).OutlineIndent
                    .Tasks(tsk.ID + 3).OutlineIndent
    
                    .Tasks(tsk.ID + 1).Start = tsk.Date1
                    .Tasks(tsk.ID + 2).Start = tsk.Date2
                    .Tasks(tsk.ID + 3).Start = tsk.Date3
    
                End With
            End If
        Next tsk
        
    End Sub