Random Number Generator to Equal a Sum

intNumberToSumTo = 40
intNumbersRequired = 6

intLowerLimit = 1
intUpperLimit = intNumberToSumTo
strNumbers = ""
Randomize
For intNum = 1 To intNumbersRequired
	intUpperLimit = intUpperLimit - (intNumbersRequired + 1 - intNum)
	intNumber = Int((intUpperLimit - intLowerLimit) * Rnd + intLowerLimit)
	intUpperLimit = (intUpperLimit + (intNumbersRequired + 1 - intNum)) - intNumber
	If strNumbers = "" Then
		strNumbers = intNumber
	Else
		strNumbers = strNumbers & "," & intNumber
	End If
Next

MsgBox strNumbers

Select allOpen in new window

Sub Test()
    MsgBox DoRand(30)
End Sub


Function DoRand(intNumber)
    Randomize
    intRemain = intNumber
    strList = ""
    While intRemain > 0
        intNext = Int((intRemain * Rnd) + 1)
        intRemain = intRemain - intNext
        If strList = "" Then
            strList = intNext
        Else
            strList = strList & "," & intNext
        End If
    Wend
    DoRand = strList
 End Function

Select allOpen in new window

Option Explicit

Private Sub CommandButton1_Click()
    Dim randomSet As Variant
    randomSet = RandomSumSet(40, 6)
    
    ' ...do something with the set...
    ListBox1.Clear
    Dim i As Integer
    For i = LBound(randomSet) To UBound(randomSet)
        ListBox1.AddItem randomSet(i)
    Next
End Sub

Private Function RandomSumSet(ByVal sum As Integer, ByVal numDigits As Integer) As Variant
    Static Seeded As Boolean
    If Not Seeded Then
        Seeded = True
        Randomize
    End If
    
    Dim numbers() As Integer
    ReDim numbers(numDigits - 1)
    
    Dim startValue As Integer
    startValue = sum \ numDigits ' Integer Division
    
    Dim i As Integer
    For i = 1 To numDigits
        numbers(i - 1) = startValue
    Next
    If numDigits * startValue <> sum Then
        numbers(numDigits - 1) = sum - ((numDigits - 1) * startValue)
    End If
    
    Dim index As Integer
    Dim j As Integer
    For j = 1 To 100
        For i = 1 To numDigits
            Do
                index = Int((numDigits - 1 + 1) * Rnd + 1)
            Loop While index = i
            If Rnd >= 0.5 Then
                If numbers(i - 1) > 1 Then
                    numbers(i - 1) = numbers(i - 1) - 1
                    numbers(index - 1) = numbers(index - 1) + 1
                End If
            Else
                If numbers(index - 1) > 1 Then
                    numbers(index - 1) = numbers(index - 1) - 1
                    numbers(i - 1) = numbers(i - 1) + 1
                End If
            End If
        Next
    Next j
    
    RandomSumSet = numbers
End Function

Select allOpen in new window

Sub rnandomnos()
While [A7] <> 40
Calculate
Wend
End Sub

To get a new set of numbers press F9 and then press the button

code below is in the attached file.

Patrick

Select allOpen in new window