I made a User Defined Function that generates a random number from a
cumulative frequency distribution (see below). The function works
properly when 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

--~--~---------~--~----~------------~-------~--~----~
-------------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at 
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
 

To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain  @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
-------------------------------------------------------------------------------------
-~----------~----~----~----~------~----~------~--~---

Reply via email to