I added an option to allow 0's or not. It does allow repeat integers.
Sub Test_kRandom() Dim a a = kRandom(100, 20) With Range("A1:A20") .ClearContents .Value = WorksheetFunction.Transpose(a) End With End Sub 'Similar to, https://codereview.stackexchange.com/questions/132075/create-a-list-of-random-numbers-with-sum-n/132078 Function kRandom(mySum As Long, kItems As Long, _ Optional tfZeros As Boolean = False) Dim myNumbers() As Long Dim i As Long, j As Long, k As Long ReDim myNumbers(mySum) Again: On Error GoTo Again i = 0 k = 0 Do jAgain: j = Int(10 * Rnd()) If Not tfZeros And j = 0 Then GoTo jAgain If k + j > mySum Then j = mySum - k k = k + j myNumbers(i) = j i = i + 1 If i > kItems - 1 Then GoTo Again Loop Until WorksheetFunction.Sum(myNumbers) = mySum ReDim Preserve myNumbers(0 To kItems - 1) 'Debug.Print i, j, k, LBound(myNumbers), UBound(myNumbers) kRandom = myNumbers End Function




Reply With Quote