Solved

Random Number Generator to Equal a Sum

Posted on 2011-03-08
8
915 Views
Last Modified: 2012-05-11
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!
0
Comment
Question by:mmylius
8 Comments
 
LVL 39

Accepted Solution

by:
nutsch earned 250 total points
ID: 35076215
Hi, that macro should do it for you, everytime in a new sheet.

Sub GetRandom()
Dim sht As Worksheet, dblSum As Double, cl As range
application.screenupdating=false

Const lgTarget As Long = 40
Const lgNumbers As Long = 6

Set sht = ActiveWorkbook.Sheets.Add

With range("A1:A" & lgNumbers)
    .FormulaR1C1 = "=rand()"
    .Value = .Value

    dblSum = application.WorksheetFunction.Sum(range("A1:A" & lgNumbers))

    For Each cl In .Cells
        cl.Value = Round((cl.Value * lgTarget / dblSum), 0)
    Next
    
    .Cells(lgNumbers, 1).Value = lgTarget - application.WorksheetFunction.Sum(range("A1:A" & lgNumbers - 1))
End With

application.screenupdating=true

End Sub

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35076428
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

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35076435
nutsch....nice one!
0
 
LVL 51

Expert Comment

by:Bill Prew
ID: 35076448
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
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 35079872
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

0
 
LVL 45

Expert Comment

by:patrickab
ID: 35081878
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
0
 

Author Closing Comment

by:mmylius
ID: 35083605
nutsch, thank you very much, that was exactly what I was looking for!
0
 

Author Comment

by:mmylius
ID: 35083613
...going to fast.. thank you to everyone who answered also!
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now