Assign random probability to chart elements

[GioRas]

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?

 

[shg]

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%​

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]

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]

Select B2:B11, paste

=RandLen(100)%

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

 

[shg]

For a minimum value of 1, use

=RandLen(100, 1)%

 

[Jon Peltier]

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]

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]

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]

	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]

Nice. I was trying to do something with a helper column, but it got too late for my tired brain.