*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