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.

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.

Random Integers With Sum N on Sulprobil

sbRandIntFixSum (VBA)

Abstract

Appendix sbRandIntFixSum Code

Download

sbLongRandSumN (VBA)

Abstract