CODEWITHSUNDEEP
vbaexcelrandom
pettiblay
pettiblay

Reputation: 33

Excel VBA Powerful Random Number Generator

I'll try and keep this as basic and to the point as possible.

Basically, I have weights/probabilities associated with a certain range of numbers. For example :

0: 10%

1: 50%

2: 15%

3: 25%

This then translates into cumulative probabilities :

0: 10%

1: 60%

2: 75%

3: 100%

Using a uniform RNG in VBA, the program generates numbers between 0 and 1, or whatever inferior limit it is set to. Using the same values as the previous example, but only generating numbers greater than 60% (and <= 100%), this results in numbers between 0.6 - 1.0.

This is where I'm stuck. I need to convert these random numbers very efficiently into their "corresponding values".

All of it is stored in VBA variables and needless to say, I don't want to have to write a Select Case for every situation since they're actually 120 different variables and weights.

As of right now, this is what I have to generate those numbers:

RandomNumber = LowerLimit + Rnd() * (1 - LowerLimit)

Thanks is advance for all your help! If I missed a post that was discussing this particular issue please feel free to refer me to it but I really didn't find anything relating to corresponding random numbers.

Upvotes: 1

Views: 4698

Answers (1)

Blackhawk
Blackhawk

Reputation: 6140

Place the following function into a public module. You would call it like so mynumber = WeightedRnd(Array(0, 1, 2, 3), Array(0.1, 0.5, 0.15, 0.25)).

Public Function WeightedRnd(values As Variant, weights As Variant) As Double
    'First, calculate the cumulative weights
    Dim cumulativeWeight As Double

    For i = 0 To UBound(weights)
        weights(i) = weights(i) + cumulativeWeight
        cumulativeWeight = weights(i)
    Next

    'Next, generate our random number
    Dim randomNumber As Double
    randomNumber = Rnd()

    'Finally, figure out which "bucket" it falls into
    For i = 0 To UBound(weights)
        If randomNumber <= weights(i) Then
            WeightedRnd = values(i)
            Exit Function
        End If
    Next
End Function

Upvotes: 2

Related Questions