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.)
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
- Anonymous
October 14, 2008
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