How to generate a series of randomly distributed numbers in sequence using Excel

Question

I have a number that I would like to normally distribute into 15 bins or cells. And I want the 15 numbers to be in sequence

Example:

Number to be distributed - 340 Output: 6 9 12 16 20 24 27 30 32 32 32 30 27 24 20

... yes, my series is not perfectly distributed but currently I'm doing this by,

• first create a linear series of number 1 2 3 4 ... 14 15
• Then use Norm.Dist(x,mean,standard_dev) to generate a series of z-score values where x=1, 2, 3 .. 14, 15
• Then I scale those values using similar triangles ie. x1/y1=x2/y2 where x1=z-score; y1=sum(z-scores); x2=number I want; y2=340

Is there a better way to do this? because I have to generate multiple matrix for this and something is not quite right...

Answer 1

Here is a hit-and-miss approach that searches for a random vector of independent normal variables whose sum falls within a given tolerance of the target sum and, if so, rescales all of the numbers so as to equal the sum exactly:

Function RandNorm(mu As Double, sigma As Double) As Double
    'assumes that Ranomize has been called
    Dim r As Double
    r = Rnd()
    Do While r = 0
        r = Rnd()
    Loop
    RandNorm = Application.WorksheetFunction.Norm_Inv(r, mu, sigma)
End Function

Function RandSemiNormVect(target As Double, n As Long, mu As Double, sigma As Double, Optional tol As Double = 1) As Variant
    Dim sum As Double
    Dim rescale As Double
    Dim v As Variant
    Dim i As Long, j As Long

    Randomize
    ReDim v(1 To n)
    For j = 1 To 10000 'for safety -- can increase if wanted
        sum = 0
        For i = 1 To n
            v(i) = RandNorm(mu, sigma)
            sum = sum + v(i)
        Next i
        If Abs(sum - target) < tol Then
            rescale = target / sum
            For i = 1 To n
                v(i) = rescale * v(i)
            Next i
            RandSemiNormVect = v
            Exit Function
        End If
    Next j
    RandSemiNormVect = CVErr(xlErrValue)
End Function

Tested like this:

Sub test()
    On Error Resume Next
    Range("A1:A15").Value = Application.WorksheetFunction.Transpose(RandSemiNormVect(340, 15, 20, 3))
    If Err.Number > 0 Then MsgBox "No Solution Found"
End Sub

Typical output with those parameters:

On the other hand, if I change the standard deviation to 1, I just get the message that no solution is found because then the probability of getting a solution within the specified tolerance of the target sum is vanishingly small.