G
Greg
I made a User Defined Function that generates a random number from a
cumulative frequency distribution (see below). The function works
properly if the workbook is recalculated when the sheet that contains
the function is active. However, the function returns a #NUM! if a
different sheet is active when the workbook is recalculated. Does
anyone know how to fix this? I get the same error whether manually
recalculating with F9 or using Application.CalculateFull from VBA.
- Greg
Function GenCFD(InRange) As Variant
'randomly select values from an input of a cumulative frequency
distribution
'The input range (InRange) should be two contiguous columns of data
'with probability values (from 0 to 1) in the first column
'and X values corresponding to each probability in the second column
Application.Volatile (True) 'recalculate this cell on pressing F9
Dim SubSetRange, Cell
Dim ir As Long, ic As Long, irprev As Long, icprev As Long, icount
As Long
Dim X As Double, Y As Double, xprev As Double, yprev As Double
Dim PRandom As Double
Dim found As Boolean
'The Set statement uses the Intersect function to create a new
range object
'that consists of the intersection of the UsedRange and the input
range,
'to minimize the loop through all cells in the range
'limited to exclude those cells that are beyond the worksheet's
"used range."
Set SubSetRange = _
Intersect(InRange.Parent.UsedRange, InRange)
ir = 0: ic = 0
X = -999: Y = -999
PRandom = YRandom
found = False
For Each Cell In SubSetRange
irprev = ir: icprev = ic
xprev = X: yprev = Y
ir = Cell.Row: ic = Cell.Column
If ir > irprev Then
X = Cells(ir, ic).value
If X < xprev Or X < 0 Or X > 1 Then
MsgBox "Check that first column for range of gencfd is
sorted values from 0 to 1"
GenCFD = CVErr(xlErrNum) 'check that first column is
sorted values from 0 to 1
End If
Y = Cells(ir, ic + 1).value
If xprev <> -999 And PRandom >= xprev And PRandom <= X Then
GenCFD = linearinterpolate(PRandom, xprev, yprev, X, Y)
found = True
Exit For
End If
End If
Next Cell
If found = False Then
GenCFD = CVErr(xlErrNum) 'didn't find a value - check that
first column is sorted values from 0 to 1
'MsgBox "Didn't find a value in GENCFD for PRandom=" & PRandom &
" - check that first column is sorted values from 0 to 1."
'End
End If
End Function
Function YRandom() As Double
Application.Volatile (True)
If (s10 = 0 And s11 = 0 And s12 = 0) And (s20 = 0 And s21 = 0 And
s22 = 0) Then
s10 = 64785
s11 = 3546
s12 = 123456
s20 = 658478
s21 = 73575
s22 = 234567
End If
Dim k As Long
Dim p1, p2 As Double
p1 = a12 * s11 - a13n * s10
k = p1 / m1
p1 = p1 - (k * m1)
If (p1 < 0) Then
p1 = p1 + m1
End If
s10 = s11
s11 = s12
s12 = p1
p2 = a21 * s22 - a23n * s20
k = p2 / m2
p2 = p2 - (k * m2)
If (p2 < 0) Then
p2 = p2 + m2
End If
s20 = s21
s21 = s22
s22 = p2
If (p1 <= p2) Then
YRandom = ((p1 - p2 + m1) * norm)
Else
YRandom = ((p1 - p2) * norm)
End If
End Function
cumulative frequency distribution (see below). The function works
properly if the workbook is recalculated when the sheet that contains
the function is active. However, the function returns a #NUM! if a
different sheet is active when the workbook is recalculated. Does
anyone know how to fix this? I get the same error whether manually
recalculating with F9 or using Application.CalculateFull from VBA.
- Greg
Function GenCFD(InRange) As Variant
'randomly select values from an input of a cumulative frequency
distribution
'The input range (InRange) should be two contiguous columns of data
'with probability values (from 0 to 1) in the first column
'and X values corresponding to each probability in the second column
Application.Volatile (True) 'recalculate this cell on pressing F9
Dim SubSetRange, Cell
Dim ir As Long, ic As Long, irprev As Long, icprev As Long, icount
As Long
Dim X As Double, Y As Double, xprev As Double, yprev As Double
Dim PRandom As Double
Dim found As Boolean
'The Set statement uses the Intersect function to create a new
range object
'that consists of the intersection of the UsedRange and the input
range,
'to minimize the loop through all cells in the range
'limited to exclude those cells that are beyond the worksheet's
"used range."
Set SubSetRange = _
Intersect(InRange.Parent.UsedRange, InRange)
ir = 0: ic = 0
X = -999: Y = -999
PRandom = YRandom
found = False
For Each Cell In SubSetRange
irprev = ir: icprev = ic
xprev = X: yprev = Y
ir = Cell.Row: ic = Cell.Column
If ir > irprev Then
X = Cells(ir, ic).value
If X < xprev Or X < 0 Or X > 1 Then
MsgBox "Check that first column for range of gencfd is
sorted values from 0 to 1"
GenCFD = CVErr(xlErrNum) 'check that first column is
sorted values from 0 to 1
End If
Y = Cells(ir, ic + 1).value
If xprev <> -999 And PRandom >= xprev And PRandom <= X Then
GenCFD = linearinterpolate(PRandom, xprev, yprev, X, Y)
found = True
Exit For
End If
End If
Next Cell
If found = False Then
GenCFD = CVErr(xlErrNum) 'didn't find a value - check that
first column is sorted values from 0 to 1
'MsgBox "Didn't find a value in GENCFD for PRandom=" & PRandom &
" - check that first column is sorted values from 0 to 1."
'End
End If
End Function
Function YRandom() As Double
Application.Volatile (True)
If (s10 = 0 And s11 = 0 And s12 = 0) And (s20 = 0 And s21 = 0 And
s22 = 0) Then
s10 = 64785
s11 = 3546
s12 = 123456
s20 = 658478
s21 = 73575
s22 = 234567
End If
Dim k As Long
Dim p1, p2 As Double
p1 = a12 * s11 - a13n * s10
k = p1 / m1
p1 = p1 - (k * m1)
If (p1 < 0) Then
p1 = p1 + m1
End If
s10 = s11
s11 = s12
s12 = p1
p2 = a21 * s22 - a23n * s20
k = p2 / m2
p2 = p2 - (k * m2)
If (p2 < 0) Then
p2 = p2 + m2
End If
s20 = s21
s21 = s22
s22 = p2
If (p1 <= p2) Then
YRandom = ((p1 - p2 + m1) * norm)
Else
YRandom = ((p1 - p2) * norm)
End If
End Function