Article ID: 124482
Article Last Modified on 1/19/2007
Sub SumFilteredList()
' This macro totals up the values in the Number1 field
' for all visible (filtered) tasks, and displays this total
' at the bottom of the task list.
Dim oTask As Task ' Current task pointer
Dim oTotalTask As Task ' Totals task pointer
Dim fTotal As Single ' Used to hold totals
' Ignore error generated by trying to delete a task
' that does not exist.
On Error Resume Next
' If totals task is present, delete it.
ActiveProject.Tasks("Total:").Delete
' Re-enable default error handling
On Error GoTo 0
' Select visible tasks
SelectAll
' If tasks are selected, then loop through each of them
If Not (ActiveSelection.Tasks Is Nothing) Then
For Each oTask In ActiveSelection.Tasks
' Add Number1 for each task to total
fTotal = fTotal + oTask.Number1 ' Field to Sum
Next oTask
Else
' There's nothing to add
Exit Sub
End If
' Create Totals task so it's visible
Set oTotalTask = ActiveProject.Tasks.Add("Total:")
' Insure "Totals:" task is at outline level 1 (not indented)
Do Until oTotalTask.OutlineLevel = 1
oTotalTask.OutlineOutdent
Loop
' Put total in proper field
oTotalTask.Number1 = fTotal ' Field containing total
' Hide task bar for this task
oTotalTask.HideBar = True
' Select totals row
SelectRow oTotalTask.ID, False
' Set font to bold
FontBold Set:=True
End Sub
Sub SumFilteredList()
' This macro totals up the values in the Number1 field
' for all visible (filtered) tasks, and displays this total
' at the bottom of the task list.
Dim oTask As Task ' Current task pointer
Dim oTotalTask As Task ' Totals task pointer
Dim fTotal As Single ' Used to hold totals
' Ignore error generated by trying to delete a task
' that does not exist.
On Error Resume Next
' If totals task is present, delete it.
ActiveProject.Tasks("Total:").Delete
' Re-enable default error handling
On Error GoTo 0
' Select visible tasks
SelectAll
' If tasks are selected, then loop through each of them
If Not (ActiveSelection.Tasks Is Nothing) Then
For Each oTask In ActiveSelection.Tasks
' Add Number1 for each task to total
fTotal = fTotal + oTask.Number1 ' Field to Sum
Next oTask
Else
' There's nothing to add
Exit Sub
End If
' Create Totals task so it's visible
Set oTotalTask = ActiveProject.Tasks.Add("Total:")
' Insure "Totals:" task is at outline level 1 (not indented)
Do Until oTotalTask.OutlineLevel = 1
oTotalTask.OutlineOutdent
Loop
' Put total in proper field
oTotalTask.Number1 = fTotal ' Field containing total
' Hide task bar for this task
oTotalTask.HideBar = True
' Select totals row
SelectRow oTotalTask.ID, False
' Set font to bold
FontBold Set:=True
End Sub
fTotal = fTotal + oTask.Cost ' Field to Sum oTotalTask.Cost1 = fTotal ' Field containing total
Keywords: kbcode kbhowto kbprogramming KB124482