Random Number Generator to Equal a Sum

Hello Experts!

I am trying to create a VB code in 2010 that will take a sum (say 40), and randomly generate a set of random numbers (say 6 total numbers) that will equal that sum.

For example, if I ran it one time, it would create:
8
7
5
9
6
5

and when I run it again, it would create:
7
10
4
8
3
8

I thank you all in advance!
nutsch

membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Hi, that's a tough one!

This is VBScript, but you might be able to translate it to .NET.

Regards,

Rob.
``````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``````
nutsch....nice one!
Bill Prew

Give this test a try.

``````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``````
~bp
That is a pretty cool answer by nutsch!

Here's another approach:
``````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)
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``````
Cells A1:A6 contain =Randbetween(1,10) and A7 contains Sum(A1:A6). Code below and in the attached file.

Patrick
``````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``````
randNos.xls