Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.
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
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
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
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
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
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Multiple Open Excel Spreadsheets | 12 | 39 | |
how to delete specific files and folders with VBA | 3 | 24 | |
Excel - Data Validation | 3 | 26 | |
Select Next Route by Time | 4 | 19 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
16 Experts available now in Live!