Moving Tasks With VBA


So the problem was that a customer wanted to be able to move a task that was at ID 7 and move it so that it was at ID 2. Sadly, VBA for Project does not contain a Task.Move method. But with a little bit of code around them you can use a Cut and Paste methods for Rows.

The example below assumes that you know the name of the task you want to move and the name of the task that currently occupies the row where you want to move the first task.

Here is a sample task list. This sample is a good test because the tasks are out of ID order. The task I want to move (name = 7) is in ID position 3 and I want to move it to where Task 2 is now (currently in ID position 9.)

image

Sub TaskMover()
Dim t As Task
Dim NewID As Integer

For Each t In ActiveProject.Tasks
    If Not (t Is Nothing) Then
        If t.Name = 2 Then
            NewID = t.ID
        End If
        If t.Name = 7 Then
            SelectRow Row:=t.ID, Rowrelative:=False
            EditCut
        End If
    End If
Next t

SelectRow Row:=NewID, Rowrelative:=False
EditPaste

End Sub

 

This code is not very elegant in that it requires us to select a row and then cut it and then select another row and then paste it. It also requires that the view in the activewindow is a Task view. There is some code we can use to test to make sure the view is the right type. “ActiveWindow.TopPane.View.Type” should be “0” or “pjTaskItem”. So it is not perfect but it gets the job done. You can use this as a starting point for your own needs.

So the new code with this view type test would look like this:

Sub TaskMover()
Dim t As Task
Dim NewID As Integer
If ActiveWindow.TopPane.View.Type = pjTaskItem Then
    For Each t In ActiveProject.Tasks
        If Not (t Is Nothing) Then
            If t.Name = 2 Then
                NewID = t.ID
            End If
            If t.Name = 7 Then
                SelectRow Row:=t.ID, Rowrelative:=False
                EditCut
            End If
        End If
    Next t
    SelectRow Row:=NewID, Rowrelative:=False
    EditPaste
End If
End Sub

Comments (1)
  1. Rod Gill says:

    Hi Brian,

    Another way of doing this if you know the Task names is:

    Sub TaskMover2()

    Dim TskFrom As Task

    Dim TskTo As Task

       If ActiveWindow.TopPane.View.Type = pjTaskItem Then

           Set TskFrom = ActiveProject.Tasks("2")

           Set TskTo = ActiveProject.Tasks("8")

           If TskFrom Is Nothing Or TskTo Is Nothing Then

               MsgBox "One of the task names does not exist, macro ended", vbCritical + vbOKOnly

           Else

               SelectRow Row:=TskFrom.ID, Rowrelative:=False

               EditCut

               SelectRow Row:=TskTo.ID, _

                    Rowrelative:=False

               EditPaste

           End If

       End If

    End Sub

Comments are closed.

Skip to main content