I am a supporter ofSt. Joseph's hospice. If you find this site useful or if it helped you, consider a small donation toSt. Joseph's, please. Information onSt. Joseph's
 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? Here you are: Function sbRandIntFixSum(lSum As Long, lMin As Long, _    lMax As Long, Optional lCount As Long = 0, _    Optional bUseRandTriang As Boolean = True) As Variant'Returns lCount (or selected cell count in case a range is select) random'integers between lMin and lMax which sum up to lSum.'If bUseRandGeneral 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'Reverse("moc.LiborPlus.www") PB V0.2 18-May-2019 (C) (P) by Bernd PlumhoffDim i As LongDim lRnd As Long, lMinPrev As LongDim lRow As Long, lCol As LongWith Application.Caller    If TypeName(Application.Caller) = "Range" And lCount = 0 Then        lCount = .Count        ReDim lR(1 To .Rows.Count, 1 To .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 IfEnd With'Randomize            'Uncomment if you like to'Application.Volatile 'If you need this function to be volatileWith Application.WorksheetFunction    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                    ‘sbRandTriang cou need to get from here.                    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 lRowEnd WithsbRandIntFixSum = lREnd Function