Blackjack Simple Monte Carlo Simulator for Microsoft Project

Monte Carlo simulation is a method of determining a probability distribution for the dates within your project. By using this technique you can determine the statistical probability of meeting a certain date. This solution uses Project and Excel together to generate the results needed to calculate probability.

What is Monte Carlo Simulation?

Monte Carlo Simulation is so named because it is based on a large number of random outcomes, just like you would find at a casino in Monte Carlo. In Monte Carlo one can never be certain if a particular gambler will win or lose, but one can be certain that the casino, overall, will never lose. This is because the games played in casinos have a slight advantage to the Casino so given a large number of gamblers - some winning and some losing - the average result will be in the Casino's favor. Monte Carlo Simulation depends on the fact that the results of a large number of individual random events will accurately describe the probability distribution of the individual event.

To illustrate this let's use a simple example from a casino. A pair of dice has a 36 possible combinations that can occur. The sum can be anywhere from 2 (1+1) to 12 (6+6) and 7 (1+6 or 2+5 or 3+4 or 4+3 or 5+2 or 6+1), is the most likely outcome. The following chart shows the probability distribution:

If we roll the dice one time we will get a result somewhere within here, maybe a seven, or maybe a two. However, if we roll the dice a couple of hundred times we will get a large number of results. If we plot those results they will closely match the outcome that is predicted by the probability distribution.

Calculating the probability distribution for two dice is very simple. It takes less time to calculate the probability distribution than it does to roll the dice a hundred times.  However if we have a schedule with a number of different tasks which are related through a series of dependencies, calculating the probability distribution is very very difficult. This is where the simulation comes in. Instead of constructing and doing the mathematics to determine the probability distribution for the schedule, we use the power of the computer to "roll the dice" for us a large number of times. We know that the results of a large enough number of tries will match the true probability.

What the simulator does:

The user enters values for the optimistic duration for each activity in the duration2 field and the pessimistic duration in the duration3 field. This sets a triangular probability distribution with the optimistic duration being the lower bound, pessimistic being the upper and the duration being the most likely value.

The user then marks the tasks that they wish to export results for by setting the Flag10 field to yes.

Once this is complete, the user runs the macro titled "Blackjack" and follows the prompts.

The output of the macro is a series of dates in an excel file. Using a simple pivot table the results can be charted showing the probability distribution. A sample excel file with calculations can be downloaded (here when I finish it).

Here is the code. Please read the instructions for installing below paying particular attention to setting the excel references correctly.

'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

 


NOTE: For information about installing these macros please click here:

To Macro Installation


 
Please Donate to support this site!


Back to Macros Page

Back to Main Page

Send me mail at:

Jack@masamiki.com