Assign random probability to chart elements

GioRas

New Member
Joined
Jan 31, 2018
Messages
2
Hi everyone, total noob here. I hope don't miss anything, in that case i apologize.

I have this task: assign a random probability to a table of items.
For example: i have a table composed by 10 elements

Item 1
Item 2
Item 3
Item 4
..
Item 10

To each one i should assign a probability, aka, a number 1 to 100 whose sum of all assigned number should be equal to 100.

Example:

10% - Item 1
15% - Item 2
10% - Item 3
20% - Item 4
5% - Item 5
5% - Item 6
13% - Item 7
7% - Item 8
11% - Item 9
9% - Item 10

The number of item could be variable and the probability should be only integers >=1. Could you help me?
 

Some videos you may like

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,752
Office Version
2010
Platform
Windows
Comfortable with a user-defined function?

A​
B​
C​
1​
Wgt
2​
Item 1
4%​
B2:B11: {=RandLen(100)%}
3​
Item 2
1%​
4​
Item 3
32%​
5​
Item 4
4%​
6​
Item 5
29%​
7​
Item 6
9%​
8​
Item 7
7%​
9​
Item 8
1%​
10​
Item 9
9%​
11​
Item 10
4%​


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
 

GioRas

New Member
Joined
Jan 31, 2018
Messages
2
Seems perfect! I managed to copy-paste the function into the Visual Basic editor as a module, but i don't understand how to properly call the command in the worksheet. i tried to copy the contents of your c2 box but #VALUE ! appears, i made some other attempts but they were unsuccessful. Just =randlen(NUMBER) gives the NUMBER back.

Sorry for my ignorance.
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,752
Office Version
2010
Platform
Windows
Select B2:B11, paste

=RandLen(100)%

... in the formula bar, press and hold the Ctrl and Shift keys, then press Enter.
 
Last edited:

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,752
Office Version
2010
Platform
Windows
For a minimum value of 1, use

=RandLen(100, 1)%
 

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,879
Office Version
365
Platform
Windows, MacOS
How about an alternative worksheet approach?

In B3:B12 I put the labels Item1 through Item 10 (and you can make it longer or shorter if you want).

In D3:D12 I entered the formula =RAND().

In D2 I entered =SUM(D3:D12) to total up all the random values.

I selected C3:C12, with C3 the active cell. I entered =D3/D$2, and held Ctrl while I pressed Enter, to put the corresponding formula into the whole range C3:C12.

I formatted C3:C12 as percentages.

No need to mess with VBA.
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,752
Office Version
2010
Platform
Windows
That's certainly simpler, but doesn't result in whole percentages:

The number of item could be variable and the probability should be only integers >=1.
It also favors mid-size numbers at the expense of small and large numbers.
 

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,879
Office Version
365
Platform
Windows, MacOS
I'll address your points in reverse order.

The random values are as evenly distributed as Excel can manage, so probably small and medium values are favored over large values. The table in the first post by Shg has two rather large values and a bunch of small values, with nothing in the 10% to almost 30% range. You have to decide which distribution best fits your needs. You also have to decide how random the values need to be.

Forcing the minimum to 1% is not too tricky. Forcing all values to an integer percentage makes the solution more difficult, while maintaining randomness.
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,752
Office Version
2010
Platform
Windows
A​
B​
C​
D​
E​
2​
numNum
10​
B2: Input
3​
sum
100​
B3: Input
4​
min
1​
B4: Input
5​
6​
Item
Cuts
Wgt
7​
1​
0​
10.00%​
B7: Input
8​
2​
90​
1.00%​
B8: =sum - numNum * min
9​
3​
89​
4.00%​
B9 and down: =RANDBETWEEN(0, B$8)
10​
4​
77​
1.00%​
C7 and down: =(SMALL($B$7:$B$17, A7 + 1) - SMALL($B$7:$B$17, A7) + min)%
11​
5​
68​
17.00%​
12​
6​
41​
14.00%​
13​
7​
12​
28.00%​
14​
8​
28​
10.00%​
15​
9​
12​
13.00%​
16​
10​
9​
2.00%​
17​
9​

Same distribution as the UDF, integer weights.
 

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,879
Office Version
365
Platform
Windows, MacOS
Nice. I was trying to do something with a helper column, but it got too late for my tired brain.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,776
Messages
5,488,778
Members
407,658
Latest member
Arias610

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top