Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.
Solved
Random Number Generator to Equal a Sum
Posted on 2011-03-08
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!
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!
[X]
Welcome to Experts Exchange
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
- Help others & share knowledge
- Earn cash & points
- Learn & ask questions
2-
2
- +3
8 Comments
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
Active today
Hi, that's a tough one!
This is VBScript, but you might be able to translate it to .NET.
Regards,
Rob.
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
Active today
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
That is a pretty cool answer by nutsch!
Here's another approach:
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
Cells A1:A6 contain =Randbetween(1,10) and A7 contains Sum(A1:A6). Code below and in the attached file.
Patrick
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
Featured Post
Ready to get started with anonymous questions today? It's easy! Learn more.
Question has a verified solution.
If you are experiencing a similar issue, please ask a related question
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Suggested Courses
Course of the Month10 days, 15 hours left to enroll
719 members asked questions and received personalized solutions in the past 7 days.
Join the community of 500,000 technology professionals and ask your questions.