Monte Carlo Simulation Help

[michaelsmith559]

Here is a screenshot of some data that I have. My goal is to run simulations given a margin of error. Range("H11") contains the number of simulations/iterations, I will be doing. The problem I am having is if I change the margin of error from say 0.1 to 0.01 or 0.001 the number of simulations increases (this is to be expected) and the macro gives an error type mismatch when I go over a certain number of simulations. The line highlighted in the macro is the output=worksheetfunction.average(u). Is there a way to correct this. Here is the screenshot and macro:

Excel 2007
	A	B	C	D	E	F	G	H	I	J
1	Values	Numbers	Probability	Count	Avg	Next Avg	Next Stdev	Stdev	Min:	1
2	1	1	17.33%	61	1	4.552408	2.65252083	2.652520807	Max:	9
3	3	2	10.23%	36	2	4.555241	2.65252081		Count:	352
4	3	3	13.35%	47	2.333333	4.558074	2.65252079	Z-Score
5	4	4	11.36%	40	2.75	4.560907	2.65252078	3.890591886
6	5	5	11.36%	40	3.2	4.563739	2.65252078			Results:
7	1	6	7.95%	28	2.833333	4.566572	2.65252079	Margin Error		4.562254
8	1	7	8.52%	30	2.571429	4.569405	2.6525208	0.1
9	4	8	10.23%	36	2.75	4.572238	2.65252083
10	3	9	9.66%	34	2.777778	4.575071	2.65252086	n
11	8				3.3			10650
12	8				3.727273	Avg	Avg Stdev
13	9				4.166667	4.563739	2.65252081
14	9				4.538462
15	2				4.357143
One

Cell Formulas
Range	Formula
F3	=AVERAGE(INDIRECT("One!A2:A" &$J$3+1),B3)
F5	=AVERAGE(INDIRECT("One!A2:A" &$J$3+1),B5)
F6	=AVERAGE(INDIRECT("One!A2:A" &$J$3+1),B6)
F13	=AVERAGE(F2:F10)
F2	=AVERAGE(INDIRECT("One!A2:A" &$J$3+1),B2)
G3	=STDEV(INDIRECT("One!A2:A" &$J$3+1),F3)
G5	=STDEV(INDIRECT("One!A2:A" &$J$3+1),F5)
G6	=STDEV(INDIRECT("One!A2:A" &$J$3+1),F6)
G13	=AVERAGE(G2:G10)
G2	=STDEV(INDIRECT("One!A2:A" &$J$3+1),F2)
J1	=MIN(A:A)
H5	='Z-Score'!D120
H11	=ROUND(((H2*H5)/H8)^2,0)
H2	=G13
C2	=D2/$J$3
D2	=COUNTIF(A:A,B2)
E2	=AVERAGE($A$2:A2)

Here is the macro:

Sub Monte_Carlo_Simulation()
Dim datapoints As Long, iterations As Long
Dim c As Long, j As Long, k As Long, l As Long, x As Double, s As Double
Dim a, u() As Long
Dim output As Double

With Sheets("One")

iterations = Range("H11").Value

ReDim u(1 To iterations, 1 To 1)

a = Range("B2:C10")

Application.ScreenUpdating = False
    
Randomize

    For c = 1 To iterations
        s = 0: x = Rnd
            For j = 1 To UBound(a)
                s = s + a(j, 2)
                    If x <= s Then
                        u(c, 1) = a(j, 1)
                    Exit For
                    End If
            Next j
    Next c

output = WorksheetFunction.Average(u)
Range("J7").Value = output

Application.ScreenUpdating = True
End With
End Sub

 

[ZVI]

WorksheetFunction.Average(u) is limited by 65536 values in array maximum. But you may use the following VBA function Avarege():

Function Average(Arr) As Double
  Dim i As Long, v As Double, x
  For Each x In Arr
    i = i + 1
    v = v + x
  Next
  Average = v / i
End Function

then replace this code line: output = WorksheetFunction.Average(u)
by that: output = Average(u)

 

[michaelsmith559]

Thanks alot, I will be trying this shortly.

Mike

 

[ZVI]

Hi Mike,
The suggested code has a memory limit for the array u() storing.
In 32 bit version of Excel it works with H8 = 0.002 but faults with "Out of Memory" error at H8 = 0.001.
The below version has no such a limitation.
It calculate sum on a fly and then divides it by the iterations count.

Sub Monte_Carlo_Simulation()
 
  Dim a()
  Dim i As Long
  Dim c As Double, n As Double, r As Double, s As Double
  Dim Total As Double
 
  With Sheets("One")
    n = Range("H11").Value
    a() = Range("B2:C10").Value
    Randomize
    For c = 1 To n
      s = 0
      r = Rnd
      For i = 1 To UBound(a)
        s = s + a(i, 2)
        If r <= s Then
          Total = Total + a(i, 1)
          Exit For
        End If
      Next
    Next
    Range("J7").Value = Total / n
  End With
 
  MsgBox "Ok!"
 
End Sub

Best Regards