Random Numbers totaling "X".

ceranes

New Member
Joined
Jan 19, 2018
Messages
12
I want to create a list of random numbers, preferably the ability to choose however many I need so that their total sum equals a value "X".

As an example, I need 5 random numbers that total 6,000. I do not want decimals.

Any ideas?

Thanks,
Chris
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,782
Office Version
  1. 2010
Platform
  1. Windows
UDF?

A​
B​
C​
D​
E​
F​
G​
2​
2241​
2501​
433​
596​
229​
A2:E2: {=RandLen(6000)}

Code:
Function RandLen(dTot As Double, _
                 Optional dMin As Double = 0#, _
                 Optional ByVal iSig As Long = 0, _
                 Optional bVolatile As Boolean = False) As Double()
  ' shg 2011, 2013

  ' UDF wrapper for adRandLen

  Dim adTmp()       As Double
  Dim adOut()       As Double
  Dim iRow          As Long
  Dim nRow          As Long
  Dim iCol          As Long
  Dim nCol          As Long

  If bVolatile Then Application.Volatile

  nRow = Application.Caller.Rows.Count
  nCol = Application.Caller.Columns.Count

  adTmp = adRandLen(dTot, nRow * nCol, dMin, iSig)
  ReDim adOut(1 To nRow, 1 To nCol)

  For iRow = 1 To nRow
    For iCol = 1 To nCol
      adOut(iRow, iCol) = adTmp((iRow - 1) * nCol + iCol)
    Next iCol
  Next iRow

  RandLen = adOut
End Function

Function adRandLen(ByVal dTot As Double, _
                   nOut As Long, _
                   Optional ByVal dMin As Double = 0#, _
                   Optional ByVal iSig As Long = 307) As Double()
  ' shg 2011

  ' Applies string-cutting to return an array of nOut
  ' numbers totalling dTot, with each in the range
  '    dMin <= number <= Round(dTot, iSig) - nOut * round(dMin, iSig)

  ' Each number is rounded to iSig decimals

  Dim iOut          As Long     ' index to iOut
  Dim jOut          As Long     ' sort insertion point
  Dim dRnd          As Double   ' random number
  Dim dSig          As Double   ' decimal significance (e.g., 1, 0.01, ...)
  Dim adOut()       As Double   ' output array

  dTot = WorksheetFunction.Round(dTot, iSig)
  dMin = WorksheetFunction.Round(dMin, iSig)
  If nOut < 1 Or dTot < nOut * dMin Then Exit Function

  ReDim adOut(1 To nOut)
  dSig = 10# ^ -iSig

  With New Collection
    .Add Item:=0#
    .Add Item:=dTot - nOut * dMin

    ' create the cuts
    For iOut = 1 To nOut - 1
      dRnd = Int(Rnd() * ((dTot - nOut * dMin) / dSig)) * dSig

      ' insertion-sort the cut
      For jOut = .Count To 1 Step -1
        If .Item(jOut) <= dRnd Then
          .Add Item:=dRnd, After:=jOut
          Exit For
        End If
      Next jOut
    Next iOut

    ' measure the lengths
    For iOut = 1 To nOut
      adOut(iOut) = .Item(iOut + 1) - .Item(iOut) + dMin
    Next iOut
  End With

  adRandLen = adOut
End Function
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,974
Office Version
  1. 365
Platform
  1. Windows
Welcome to the Board!

Here is my stab at it. There is a procedure that prompts you for your total, and the number of random numbers that you want that equal that total. I then returns them to a MsgBox, separated by semi-colons, but that can easily be changed to return wherever you want.
Code:
Sub GenerateRandomNums()

    Dim total As Long
    Dim num As Long
    Dim l As Long
    Dim mySum As Long
    Dim upper As Long
    Dim rndNum As Long
    Dim vals As String
    
'   Prompt user for entry
    total = InputBox("What is the total you want the numbers to add up to?")
'   Check entry
    If total < 0 Then
        MsgBox "Total must be greater than zero", vbOKOnly, "ENTRY ERROR!"
        Exit Sub
    End If
    
'   Prompt user for entry
    num = InputBox("How many random numbers do you want?")
'   Check entry
    If num < 2 Then
        MsgBox "Number of random numbers must be at least 2", vbOKOnly, "ENTRY ERROR!"
        Exit Sub
    End If

'   Find all random numbers expect last one
    For l = 1 To (num - 1)
        upper = total - mySum
        rndNum = RandNum(1, upper)
        vals = vals & rndNum & ";"
        mySum = mySum + rndNum
    Next l

'   Find last random number
    rndNum = total - mySum
    vals = vals & rndNum
    
'   Return list of random numbers
    MsgBox vals

End Sub


Function RandNum(lower As Long, upper As Long) As Integer
'   Find a random number between the two numbers
    RandNum = Int((upper - lower + 1) * Rnd + lower)
End Function
 

Eric W

MrExcel MVP
Joined
Aug 18, 2015
Messages
10,642

ADVERTISEMENT

Here's a formula solution:

ABCD
1SumCountList
2600063115
3510
41361
5289
6443
7282
8

<colgroup><col style="width: 25pxpx"><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet11

Worksheet Formulas
CellFormula
D2=IF(ROWS($D$2:$D2)>$B$2,"",IF(ROWS($D$2:$D2)=$B$2,$A$2-SUM($D$1:$D1),RANDBETWEEN(1,$A$2-SUM($D$1:$D1)-($B$2-ROWS($D$2:$D2)))))

<thead>
</thead><tbody>
</tbody>

<tbody>
</tbody>



Just press F9 for a new set.
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,974
Office Version
  1. 365
Platform
  1. Windows

ceranes,
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation:
Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,477
Messages
5,601,893
Members
414,479
Latest member
Beau the dog

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top