Random Numbers on Sulprobil

sbRandGeneral (VBA)

Thu, 14 May 2026 16:01:00 +0100

“It pays to be obvious, especially if you have a reputation for subtlety.” [Isaac Asimov]

Abstract

If you want to create a step-wise linear random number distribution - and you can approximate any distribution with a given accuracy with such one - then you can use my user defined function sbRandGeneral.

Documentation

The documentation for this application you can open and read here:

Please read my Disclaimer.

080102_PB_01_General_Doc.pdf [30 KB PDF file, download, open, and use at your own risk]

sbRandTrigen (VBA)

Thu, 14 May 2026 15:47:00 +0100

Abstract

Please notice that sbRandTrigen needs and calls sbRandTriang.

Documentation

The documentation for this application you can open and read here:

Please read my Disclaimer.

071228_PB_02_Trigen_Doc.pdf [38 KB PDF file, download, open, and use at your own risk]

Appendix – sbRandTrigen Code

Please read my Disclaimer.

Option Explicit

Function sbRandTrigen(dBottom As Double, dMode As Double, _
    dTop As Double, dBottomPerc As Double, _
    dTopPerc As Double, Optional dRandom = 1#) As Double
'Generates dMin random number, Triang distributed
'with given first and last decile
'[see Vose: Risk Analysis, 2nd ed., p. 129]
'Source (EN): http://www.sulprobil.de/sbrandgeneral_en/
'Source (DE): http://www.berndplumhoff.de/sbrandgeneral_de/
'(C) (P) by Bernd Plumhoff 19-Nov-2011 PB V0.32
'Similar to @RISK's (C) RiskTrigen function.
'sbRandTrigen(bottom, mode, top, bottom percentile, top percentile)
'specifies a triangular distribution with three points — one
'at the mode and two at the specified bottom and top percentiles.
'The bottom percentile and top percentile are values between
'0 and 100. Each percentile value gives the percentile of the
'total area under the triangle that is on the left side of the
'given point.
'Example:
'sbRandTrigen(1,8,10,20,95) will call
'sbRandTriang(-6.13212712795534, 8, 11.8648937411641).
'Please ensure that you execute Randomize before you call 
'this function for the first time.

Static dBottomLast As Double
Static dModeLast As Double
Static dTopLast As Double
Static dBottomPercLast As Double
Static dTopPercLast As Double
Static dMin As Double
Static dMax As Double
Dim dMaxNew As Double
Dim da0 As Double, da1 As Double, da2 As Double
Dim da3 As Double, da4 As Double
Dim dfe As Double, df1e As Double
Dim dBottomPerc2 As Double, dTopPerc2 As Double
Dim i As Long

If dBottom = dBottomLast And dMode = dModeLast And dTop = dTopLast _
   And dBottomPerc = dBottomPercLast And dTopPerc = dTopPercLast _
   And Not IsError(dMin) Then
    sbRandTrigen = sbRandTriang(dMin, dMode, dMax, dRandom)
    Exit Function
End If

dBottomLast = dBottom
dModeLast = dMode
dTopLast = dTop
dBottomPercLast = dBottomPerc
dTopPercLast = dTopPerc

dBottomPerc2 = dBottomPerc / 100#
dTopPerc2 = 1# - dTopPerc / 100#
If dMode <= dBottom Or dTop <= dMode Then
    dMin = CVErr(xlErrValue) 'Trigger rerun next time
    sbRandTrigen = CVErr(xlErrValue)
    Exit Function
End If
If dBottomPerc2 < 0# Or dTopPerc2 < 0# Then
    dMin = CVErr(xlErrDiv0) 'Trigger rerun next time
    sbRandTrigen = CVErr(xlErrValue)
    Exit Function
End If

If dTopPerc2 = 0# Then
    If dBottomPerc2 = 0# Then
        sbRandTrigen = sbRandTriang(dBottom, dMode, dTop, dRandom)
        Exit Function
    End If
    sbRandTrigen = sbRandTrigen(dBottom, dMode, dTop, dBottomPerc2, dTopPerc2)
    Exit Function
End If

da4 = dBottomPerc2 * dTopPerc2 - dBottomPerc2 + 1# - 2# * dTopPerc2 + dTopPerc2 ^ 2#
da3 = -2# * dBottomPerc2 * dTopPerc2 * dTop - 2# * dBottomPerc2 * dTopPerc2 * dMode - _
      4# * dTop + 4# * dBottomPerc2 * dTop + 2# * dTopPerc2 * dMode + 4# * dTopPerc2 * _
      dTop + 2# * dTopPerc2 * dBottom - 2# * dTopPerc2 ^ 2# * dMode - _
      2# * dTopPerc2 ^ 2# * dBottom
da2 = dBottomPerc2 * dTopPerc2 * dTop ^ 2# + 4# * dBottomPerc2 * dTopPerc2 * dMode * _
      dTop + dBottomPerc2 * dTopPerc2 * dMode ^ 2# - 6# * dBottomPerc2 * dTop ^ 2# + _
      6# * dTop ^ 2# - 4# * dTopPerc2 * dMode * dTop - 2# * dTopPerc2 * dTop ^ 2# - 2# * _
      dTopPerc2 * dBottom * dMode - 4# * dTopPerc2 * dBottom * dTop + dTopPerc2 ^ 2# * _
      dMode ^ 2# + 4# * dTopPerc2 ^ 2# * dBottom * dMode + dTopPerc2 ^ 2# * dBottom ^ 2#
da1 = -2# * dBottomPerc2 * dTopPerc2 * dMode * dTop ^ 2# - 2# * dBottomPerc2 * dTopPerc2 * _
      dMode ^ 2# * dTop + 4# * dTop ^ 3# * dBottomPerc2 - 4# * dTop ^ 3# + 2# * dTopPerc2 * _
      dMode * dTop ^ 2# + 4# * dTopPerc2 * dBottom * dMode * dTop + 2# * dTopPerc2 * _
      dBottom * dTop ^ 2# - 2# * dTopPerc2 ^ 2# * dBottom * dMode ^ 2# - 2# * _
      dTopPerc2 ^ 2# * dBottom ^ 2# * dMode
da0 = dBottomPerc2 * dTopPerc2 * dMode ^ 2# * dTop ^ 2# - dBottomPerc2 * dTop ^ 4# + dTop ^ 4# - _
      2# * dTopPerc2 * dBottom * dMode * dTop ^ 2# + dTopPerc2 ^ 2# * dBottom ^ 2# * dMode ^ 2#
     
dMax = dTop + (dTop - dMode) / (1# - dTopPerc2) ^ 2#

'Newton iteration
Do While Abs(dMaxNew - dMax) > 0.000000000001

    i = i + 1
    If i > 30 Then
        If Abs(dfe) > 0.000000000001 Then
            dMin = CVErr(xlErrDiv0) 'Trigger rerun next time
            sbRandTrigen = CVErr(xlErrValue)
            Exit Function
        Else
            Exit Do
        End If
    End If
    dMaxNew = dMax
    dfe = da4 * dMaxNew ^ 4# + da3 * dMaxNew ^ 3# + da2 * dMaxNew ^ 2# + da1 * dMaxNew + da0
    df1e = 4# * da4 * dMaxNew ^ 3# + 3# * da3# * dMaxNew ^ 2# + 2# * da2 * dMaxNew + da1
    dMax = dMax - dfe / df1e

Loop

dMin = dMax - (dMax - dTop) ^ 2# / dTopPerc2 / (dMax - dMode)
sbRandTrigen = sbRandTriang(dMin, dMode, dMax, dRandom)
End Function

Download

Please read my Disclaimer.

sbRandTriang (VBA)

Thu, 14 May 2026 14:47:00 +0100

Abstract

The triangular distribution is a continuous probability distribution with a probability density function shaped like a triangle. It is a simple distribution because you only need its mininimum, its median, and its maximum value:

This distribution is sometimes also called the distribution of missing data because you can use it with a minimal given amount of information. It is often used to simulate expert opinions or when it is too difficult or too expensive to gather more data.

sbRandSum1 (VBA)

Thu, 14 May 2026 12:46:00 +0100

Abstract

We present an example of a random number generation with a side condition. The sum of all created random numbers should be 1. This can be achieved by many different approaches.

Three possible approaches are:

Reduce grade of freedom successively: create first random number, then the second one in range[0,1-first), the third one in [0,1-first-second), …, the last will be 1-sum of all others
Create n random numbers and divide them by their sum

sbRandIntFixSum (VBA)

Thu, 14 May 2026 11:46:00 +0100

Abstract

You want to create lCount random integers between a lower boundary lMin and an upper boundary lMax, and they need to sum up to exactly lSum?

This function is similar to sbLongRandSumN.

Please note that you need to include the program sbRandTriang.

Appendix sbRandIntFixSum Code

Please read my Disclaimer.

Option Explicit

Function sbRandIntFixSum(lSum As Long, lMin As Long, _
    lMax As Long, Optional lCount As Long = 0, _
    Optional bUseRandTriang As Boolean = True, _
    Optional bVolatile As Boolean = False) As Variant
'Returns lCount (or selected cell count in case a range is select when
'called as a matrix formula) random integers between lMin and lMax
'which sum up to lSum. If bUseRandTriang the sbRandTriang distribution
'is used to "bias" the randomness to be "less extreme".

'Error values:
'#NUM!   - No solution exists
'#VALUE! - lCount is less than 1
'Source (EN): http://www.sulprobil.de/sbrandintfixsum_en/
'Source (DE): http://www.berndplumhoff.de/sbrandintfixsum_de/
'(C) (P) by Bernd Plumhoff 05-Aug-2020 PB V0.3

Dim i As Long
Dim lRnd As Long, lMinPrev As Long
Dim lRow As Long, lCol As Long

With Application

If TypeName(.Caller) = "Range" And lCount = 0 Then
    lCount = .Caller.Count
    ReDim lR(1 To .Caller.Rows.Count, 1 To .Caller.Columns.Count) As Long
ElseIf lCount < 1 Then
    sbRandIntFixSum = CVErr(xlErrValue)
    Exit Function
Else
    ReDim lR(1 To lCount, 1 To 1) As Long
End If

Randomize
If bVolatile Then .Volatile

For lRow = 1 To UBound(lR, 1)
    For lCol = 1 To UBound(lR, 2)
        lMinPrev = lMin
        lMin = .RoundUp(.Max(lMin, .Min(lSum / lCount, lSum / lCount _
               - (lCount - 1) * (lMax - lSum / lCount))), 0)
        lMax = .RoundDown(.Min(lMax, .Max(lSum / lCount, lSum / lCount _
               + (lCount - 1) * (lSum / lCount - lMinPrev))), 0)
        If lMin > lMax Or lSum / lCount <> .Median(lMin, lMax, lSum / _
            lCount) Then
            'No solution exists
            sbRandIntFixSum = CVErr(xlErrNum)
            Exit Function
        End If
        If bUseRandTriang Then
            If lMin = lMax Then
                lRnd = lMin
            Else
                lRnd = Int(sbRandTriang(CDbl(lMin), _
                       lSum / lCount, CDbl(lMax)) + 0.5)
            End If
        Else
            lRnd = Int(Rnd() * (lMax - lMin + 1) + lMin)
        End If
        lR(lRow, lCol) = lRnd
        lSum = lSum - lRnd
        lCount = lCount - 1
    Next lCol
Next lRow

sbRandIntFixSum = lR
End With

End Function

Sub GenerateRandIntFixSum()
[E7:E27].FormulaArray = sbRandIntFixSum([B1], [B2], [B3], [B4], True, False)
End Sub

Download

Please read my Disclaimer.

sbGrowthSeries (VBA)

Thu, 14 May 2026 10:47:00 +0100

Abstract

You can generate random data with a compound growth rate dblRate, with a maximal relative change rate per step of dblMaxRatePerStep and with an optional start value dblStartVal. The number of periods is implicitly chosen by the number of selected cells which call this function as an array formula (entered with CTRL + SHIFT + ENTER). This is sort of a brownian bridge.

Appendix – sbGrowthSeries Code

Please read my Disclaimer.

sbGenerateTeams (VBA)

Thu, 14 May 2026 09:46:00 +0100

“For many people my software is something that you install and forget. I like to keep it that way.” [Wietse Venema]

Abstract

You and your 15 friends want to play in teams of 4 and you wonder how to come up with a fair distribution of teams, because each player has an individual skill level?

Here you go:

This program combines several features which I like to use:

The class SystemState helps to reduce runtime.

sbRandHistogrm (VBA)

Thu, 14 May 2026 06:46:00 +0100

Abstract

Appendix sbRandHistogrm Code

Please read my Disclaimer.

Function sbRandHistogrm(dmin As Double, dMax As Double, _
            vWeight As Variant, Optional dRandom = 1#) As Double
'Specifies a histogram distribution with range dmin:dmax.
'This range is divided into vWeight.count classes. Each
'class has weight vWeight(i) reflecting the probability
'of occurrence of a value within the class.
'Similar to @Risk's function RiskHistogrm.
'Source (EN): http://www.sulprobil.de/sbrandhistogrm_en/
'Source (DE): http://www.berndplumhoff.de/sbrandhistogrm_de/
'(C) (P) by Bernd Plumhoff 18-Oct-2020 PB V1.01

Dim i As Long, n As Long, vW As Variant
Dim dRand As Double, dR As Double, dSumWeight As Double

With Application.WorksheetFunction
vW = .Transpose(.Transpose(vWeight))
End With

n = UBound(vW)
ReDim dSumWeightI(0 To n) As Double
   
dSumWeight = 0#
dSumWeightI(0) = 0#
For i = 1 To n
    If vW(i) < 0# Then 'A negative weight is an error
        sbRandHistogrm = CVErr(xlErrValue)
        Exit Function
    End If
    dSumWeight = dSumWeight + vW(i) 'Calculate sum of all weights
    dSumWeightI(i) = dSumWeight     'Calculate sum of weights till i
Next i

If dSumWeight = 0# Then  'Sum of weights has to be greater than zero
    sbRandHistogrm = CVErr(xlErrValue)
    Exit Function
End If

If dRandom = 1# Then
    dRand = Rnd()
Else
    dRand = dRandom
End If
dR = dSumWeight * dRand

i = n
Do While dR < dSumWeightI(i)
    i = i - 1
Loop

sbRandHistogrm = dmin + (dMax - dmin) * _
     (CDbl(i) + (dR - dSumWeightI(i)) / vW(i + 1)) / CDbl(n)

End Function

Please read my Disclaimer.

sbLongRandSumN (VBA)

Thu, 14 May 2026 05:46:00 +0100

Abstract

You need to generate 20 non-negative random integers which sum up to 100? Then I suggest to use my UDF below. You can generate an arbitrary number of integers which sum up to a specified amount, and all generated integers are not smaller than another specified number:

Please notice that this function is a relative of sbRandIntFixSum (for which you need to provide non-optional minimum and maximum values to be generated), the brownian bridge sbGrowthSeries, and of sbRandSum1 which generates numbers of type Double which sum up to one exactly. This function is used in my application sbGenerateTestData, for example.

sbExactRandHistogrm (VBA)

Thu, 14 May 2026 04:46:00 +0100

“Chance favours the prepared mind.” [Louis Pasteur]

Abstract

It is fairly easy to create a loaded die, let us say on average the 6 should appear twice as often as all the other numbers 1 thru 5: Enter into A1: =MIN(INT(RAND()*7+1),6)

But what if you want to create 7 rolls of this die and all numbers between 1 and 5 should appear exactly once and 6 exactly twice?

Here is my general solution: