I found this VBA code and I'm trying to implement it in Project 2010 but it keeps coming up with an Overflow Error. I highlighted the problem line
'set some global variables
Dim iter As Integer
Dim exportedTasks, monteCarloTasks As Tasks
Dim myCancel As Boolean
Sub Blackjack()
'A simple monte carlo simulation macro for Microsoft Project
'User marks tasks to export data for by entering yes in the flag10 field
'User enters an optimistic duration in the duration2 field
'and a pessimistic duration in the duration3 field
'The macro uses those durations along with the standard duration
'as the points of a triangular distribution
'It then iterates through all the tasks a number of times up to 3000
'The data is then exported to Excel where through the data tool
'(pivot tables etc.) the user can analyze and graph the results.
'Copyright 2004 - Jack Dahlgren
'version 1.0
Dim i As Integer
Dim dates As String
Dim xlRow As Excel.Range
Dim t As Task
Dim ts As Integer
myCancel = False
'Prompt for number of iterations
getIter
'get collection of tasks to export
setExportedTasks
'get collection of tasks to perform simulation on
setMonteCarloTasks
'set the random seed
Randomize
'If the user cancels out of earlier subprocedure
'or if they have an error (no tasks for example) then
'myCancel is set to true and is passed to exit this subprocedure
If myCancel = True Then Exit Sub
'create a new instance of excel
'and set it up
Set xlApp = New Excel.Application
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = ActiveProject.Name
Set xlRow = xlApp.ActiveCell
'turn off screenupdating to reduce the time spent updating the screen
'I'm not sure this has too much of an effect on this code.
xlApp.ScreenUpdating = False
MSProject.ScreenUpdating = False
ts = 0
'write out the task names for exported tasks in the first row
For Each t In exportedTasks
xlRow = t.Name
Set xlRow = xlRow.Offset(0, 1)
ts = ts + 1
Next t
'iter is the number of iterations chosen by the user
'this loop sets the duration to a random but representative
'value within the triangular distribution, recalcs the project and then
'writes the results to excel one time for each iteration
For i = 0 To iter
Set xlRow = xlRow.Offset(1, 0)
Set xlRow = xlRow.Offset(0, -ts)
'Here we call the TriDist function which returns a value we will use for
'the duration. We do this for all valid tasks
For Each t In monteCarloTasks
t.Duration = TriDist(Rnd(), t.Duration2, t.Duration, t.Duration3)
Next t
'once the new duration is set we recalculate the schedule
Application.CalculateProject
'then write to excel
For Each t In exportedTasks
xlRow = t.Finish
Set xlRow = xlRow.Offset(0, 1)
Next t
Next i
'When we are done we reset the duration to what it was at the beginning
'this value has been store in the setMonteCarloTasks subprocedure
For Each Task In ActiveProject.Tasks
Task.Duration = Task.Duration1
Next Task
'turn the screen updating back on so we can see the results
xlApp.ScreenUpdating = True
MSProject.ScreenUpdating = True
'and finally display a message that we are finished
AppActivate "Microsoft Project"
MsgBox "Done"
xlApp.Visible = True
AppActivate "Microsoft Excel"
End Sub
Sub getIter()
'prompts user for number of iterations
'recurses if value is not numeric or
'is out of range
Dim Viter As Variant
'ask the user for a value. Default is 500, so clicking OK
'should be the easiest/best choice
Viter = InputBox("Enter Number of Iterations" & Chr(13) & "Must be between 0 and 3000", "Jack's Free Monte Carlo Simulator", 500)
'check to see if what the user entered is a number
If Not IsNumeric(Viter) Then
'if it isn't tell them
MsgBox "the value you have entered is not a number"
'and ask again
getIter
Else
'check to see if the number is a decent number.
'good results probably need at least a hundred iterations and
'more than a thousand or so usually will add little
If ((0 < Viter) And (3001 > Viter)) Then
'convert the user's answer to an integer
'and set our variable to the integer
iter = CInt(Viter)
Else
MsgBox "You must enter a value less than 3000"
'once again a bad answer here means we ask the
'question again by recursively calling getIter
getIter
End If
End If
End Sub
Sub setExportedTasks()
'filters to get collection of tasks for export
'with flag10 set to yes
'warn if export is more than 20 tasks
'Tasks are filtered for a positive value in flag10
FilterEdit Name:="_MCexportedTasks", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Flag10", Test:="equals", Value:="yes", ShowInMenu:=False, ShowSummaryTasks:=False
FilterApply Name:="_MCexportedTasks"
'then the tasks are selected
SelectAll
'if there are no tasks that meet the criteria we display a warning and quit
If ActiveSelection = 0 Then
'this line is needed to tell the "monte" subprocedure to exit too.
myCancel = True
MsgBox "You have no tasks to export data for" & Chr(13) _
& "Please check the flag10 field to be sure that some tasks are marked YES"
Exit Sub
End If
'take the selection and turn it into a collection of tasks
Set exportedTasks = ActiveSelection.Tasks
exportcount = exportedTasks.Count
'we don't want to operate on more than 25
'and even that is a large number. 5 or so would make sense
If exportcount > 25 Then
'this asks if it is ok and if it is not OK then we exit as before
If MsgBox("You are exporting " & exportcount & " tasks" & Chr(13) & "Are you sure you want to continue?", vbOKCancel, "Large Export Warning") = vbCancel Then
myCancel = True
Exit Sub
End If
End If
End Sub
Sub setMonteCarloTasks()
Dim t As Task
'filters to get collection of tasks for export
'with flag11 set to yes
For Each t In ActiveProject.Tasks
'this part does two things
If Not t Is Nothing Then
'first it stores the duration into duration1 so we can restore it
'back to what it was when we finish calculating
t.Duration1 = t.Duration
t.Flag11 = "No"
If Not t.Summary Then
'second it checks to see if optimistic and pessimistic durations
'are entered for tasks. If they are then flag11 is set to indicate
'that it is a task that should be calculated. If there is missing data or
'bad data we ignore the task
'Probably a good idea to have a routine that helps users enter
'and check these before starting
If (t.Duration >= t.Duration2) And (t.Duration <= t.Duration3) Then
t.Flag11 = "Yes"
End If
End If
End If
Next t
'now we filter for valid tasks
FilterEdit Name:="_MCTasks", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Flag11", Test:="equals", Value:="yes", ShowInMenu:=False, ShowSummaryTasks:=False
FilterApply Name:="_MCTasks"
SelectAll
'check to make sure there is at least one
If ActiveSelection = 0 Then
MsgBox "You have no valid tasks for the macro to work on"
myCancel = True
Exit Sub
End If
'and finally set them as the tasks we will recalculate
Set monteCarloTasks = ActiveSelection.Tasks
End Sub
Function TriDist(ByVal prob As Single, ByVal opt As Single, ByVal expect As Single, ByVal pess As Single)
'this function returns a value from within the triangularity probablility
Dim x, d As Single
d = pess - opt
x = (expect - opt) / d
If prob <= x Then TriDist = opt + (((prob * x) ^ 0.5) * d)
If prob > x Then TriDist = pess - ((((1 - prob) * (1 - x)) ^ 0.5) * d)
End Function
'set some global variables
Dim iter As Integer
Dim exportedTasks, monteCarloTasks As Tasks
Dim myCancel As Boolean
Sub Blackjack()
'A simple monte carlo simulation macro for Microsoft Project
'User marks tasks to export data for by entering yes in the flag10 field
'User enters an optimistic duration in the duration2 field
'and a pessimistic duration in the duration3 field
'The macro uses those durations along with the standard duration
'as the points of a triangular distribution
'It then iterates through all the tasks a number of times up to 3000
'The data is then exported to Excel where through the data tool
'(pivot tables etc.) the user can analyze and graph the results.
'Copyright 2004 - Jack Dahlgren
'version 1.0
Dim i As Integer
Dim dates As String
Dim xlRow As Excel.Range
Dim t As Task
Dim ts As Integer
myCancel = False
'Prompt for number of iterations
getIter
'get collection of tasks to export
setExportedTasks
'get collection of tasks to perform simulation on
setMonteCarloTasks
'set the random seed
Randomize
'If the user cancels out of earlier subprocedure
'or if they have an error (no tasks for example) then
'myCancel is set to true and is passed to exit this subprocedure
If myCancel = True Then Exit Sub
'create a new instance of excel
'and set it up
Set xlApp = New Excel.Application
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = ActiveProject.Name
Set xlRow = xlApp.ActiveCell
'turn off screenupdating to reduce the time spent updating the screen
'I'm not sure this has too much of an effect on this code.
xlApp.ScreenUpdating = False
MSProject.ScreenUpdating = False
ts = 0
'write out the task names for exported tasks in the first row
For Each t In exportedTasks
xlRow = t.Name
Set xlRow = xlRow.Offset(0, 1)
ts = ts + 1
Next t
'iter is the number of iterations chosen by the user
'this loop sets the duration to a random but representative
'value within the triangular distribution, recalcs the project and then
'writes the results to excel one time for each iteration
For i = 0 To iter
Set xlRow = xlRow.Offset(1, 0)
Set xlRow = xlRow.Offset(0, -ts)
'Here we call the TriDist function which returns a value we will use for
'the duration. We do this for all valid tasks
For Each t In monteCarloTasks
t.Duration = TriDist(Rnd(), t.Duration2, t.Duration, t.Duration3)
Next t
'once the new duration is set we recalculate the schedule
Application.CalculateProject
'then write to excel
For Each t In exportedTasks
xlRow = t.Finish
Set xlRow = xlRow.Offset(0, 1)
Next t
Next i
'When we are done we reset the duration to what it was at the beginning
'this value has been store in the setMonteCarloTasks subprocedure
For Each Task In ActiveProject.Tasks
Task.Duration = Task.Duration1
Next Task
'turn the screen updating back on so we can see the results
xlApp.ScreenUpdating = True
MSProject.ScreenUpdating = True
'and finally display a message that we are finished
AppActivate "Microsoft Project"
MsgBox "Done"
xlApp.Visible = True
AppActivate "Microsoft Excel"
End Sub
Sub getIter()
'prompts user for number of iterations
'recurses if value is not numeric or
'is out of range
Dim Viter As Variant
'ask the user for a value. Default is 500, so clicking OK
'should be the easiest/best choice
Viter = InputBox("Enter Number of Iterations" & Chr(13) & "Must be between 0 and 3000", "Jack's Free Monte Carlo Simulator", 500)
'check to see if what the user entered is a number
If Not IsNumeric(Viter) Then
'if it isn't tell them
MsgBox "the value you have entered is not a number"
'and ask again
getIter
Else
'check to see if the number is a decent number.
'good results probably need at least a hundred iterations and
'more than a thousand or so usually will add little
If ((0 < Viter) And (3001 > Viter)) Then
'convert the user's answer to an integer
'and set our variable to the integer
iter = CInt(Viter)
Else
MsgBox "You must enter a value less than 3000"
'once again a bad answer here means we ask the
'question again by recursively calling getIter
getIter
End If
End If
End Sub
Sub setExportedTasks()
'filters to get collection of tasks for export
'with flag10 set to yes
'warn if export is more than 20 tasks
'Tasks are filtered for a positive value in flag10
FilterEdit Name:="_MCexportedTasks", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Flag10", Test:="equals", Value:="yes", ShowInMenu:=False, ShowSummaryTasks:=False
FilterApply Name:="_MCexportedTasks"
'then the tasks are selected
SelectAll
'if there are no tasks that meet the criteria we display a warning and quit
If ActiveSelection = 0 Then
'this line is needed to tell the "monte" subprocedure to exit too.
myCancel = True
MsgBox "You have no tasks to export data for" & Chr(13) _
& "Please check the flag10 field to be sure that some tasks are marked YES"
Exit Sub
End If
'take the selection and turn it into a collection of tasks
Set exportedTasks = ActiveSelection.Tasks
exportcount = exportedTasks.Count
'we don't want to operate on more than 25
'and even that is a large number. 5 or so would make sense
If exportcount > 25 Then
'this asks if it is ok and if it is not OK then we exit as before
If MsgBox("You are exporting " & exportcount & " tasks" & Chr(13) & "Are you sure you want to continue?", vbOKCancel, "Large Export Warning") = vbCancel Then
myCancel = True
Exit Sub
End If
End If
End Sub
Sub setMonteCarloTasks()
Dim t As Task
'filters to get collection of tasks for export
'with flag11 set to yes
For Each t In ActiveProject.Tasks
'this part does two things
If Not t Is Nothing Then
'first it stores the duration into duration1 so we can restore it
'back to what it was when we finish calculating
t.Duration1 = t.Duration
t.Flag11 = "No"
If Not t.Summary Then
'second it checks to see if optimistic and pessimistic durations
'are entered for tasks. If they are then flag11 is set to indicate
'that it is a task that should be calculated. If there is missing data or
'bad data we ignore the task
'Probably a good idea to have a routine that helps users enter
'and check these before starting
If (t.Duration >= t.Duration2) And (t.Duration <= t.Duration3) Then
t.Flag11 = "Yes"
End If
End If
End If
Next t
'now we filter for valid tasks
FilterEdit Name:="_MCTasks", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Flag11", Test:="equals", Value:="yes", ShowInMenu:=False, ShowSummaryTasks:=False
FilterApply Name:="_MCTasks"
SelectAll
'check to make sure there is at least one
If ActiveSelection = 0 Then
MsgBox "You have no valid tasks for the macro to work on"
myCancel = True
Exit Sub
End If
'and finally set them as the tasks we will recalculate
Set monteCarloTasks = ActiveSelection.Tasks
End Sub
Function TriDist(ByVal prob As Single, ByVal opt As Single, ByVal expect As Single, ByVal pess As Single)
'this function returns a value from within the triangularity probablility
Dim x, d As Single
d = pess - opt
x = (expect - opt) / d
If prob <= x Then TriDist = opt + (((prob * x) ^ 0.5) * d)
If prob > x Then TriDist = pess - ((((1 - prob) * (1 - x)) ^ 0.5) * d)
End Function
