Avatar of mmylius
mmylius
Flag for United States of America asked on

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!
Microsoft ExcelVB Script

Avatar of undefined
Last Comment
mmylius

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
nutsch

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
RobSampson

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

Open in new window

RobSampson

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

Open in new window

~bp
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Mike Tomlinson

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)
        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

Open in new window

patrickab

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

Open in new window

randNos.xls
mmylius

ASKER
nutsch, thank you very much, that was exactly what I was looking for!
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
mmylius

ASKER
...going to fast.. thank you to everyone who answered also!