Create a list of random numbers with sum = n

I want to create a list of random integers in the range [0, 9], that sums up to 100 in Excel, using VBA. The list should be printed in a single column.

The routine I've written is as follows:

Sub RandomList()
Dim arr(100) As Integer
Dim i As Integer

i = 0
Do
arr(i) = Int(10 * Rnd())
i = i + 1
Loop Until WorksheetFunction.Sum(arr) >= 100

arr(i - 1) = 100 - WorksheetFunction.Sum(arr) + arr(i - 1)
Range("A1").Resize(i, 1) = Application.Transpose(arr)

End Sub


This gives the correct result, but I'm sure there are ways to improve it:

• Initializing the size to 100, seems odd. I want to use a dynamic sized array, but I can't get it to work. I've tried different approaches, but all result in a list containing only zeros (or an error).

• I tried to sum all elements except the last one, but I didn't manage to make it work. Therefore I had to sum all elements, and subtract the last one. I can't believe that's optimal.

• Should I delete the (100-i) last elements of the list somehow, before writing it to Excel? How and why?

• Is the last line a good way of writing to Excel, or is there a better way?

• I'm looking for a nice and clean way of doing this task, not necessarily the fastest way

I can do the same thing using Function RandomList() too, but as far as I can tell, that's used when I want to call the function from the worksheet.

PS! I'm not interested in some builtin function that can do the task directly, as I'm doing this to learn VBA, not to do that specific task.

This is inspired by this (bad) question on SO. There are other approaches there that can be used, but they are substantially different. I'm wondering if the way I'm doing this is a "good way" of doing it, or if it's filled with "Bad practice" code.

Your logic is hacky, and your array should be dynamic.

Then, you should generalise your function so it can be used in other circumstances.

Also, Logic Error:

You've assumed that you won't need more elements than your target sum. But what if Rnd() returns 100 zeroes? You'll get to i = 101, try to set the value of arr(101) and error because you only sized it for 100 elements. Hence why you need a dynamic array.

Dynamic array:

Dim dynamicArray () As Integer
ReDim dynamicArray (1 to 1)

Dim i As Long
For i = 1 to 100
    ReDim Preserve dynamicArray (1 to i)
Next i

Redim Preserve extends the dimension whilst preserving all the values already in it. It only works on the last dimension so if, for instance, you had a 2-D Array, you could only Redim Preserve the 2nd Dimension.

Better Logic:

Start a counter at 100 (call it remainder)

Add random Int from 0-9 to list

Remove Int from counter

Do until counter

• targetSum

• (Optional) level of precision (integers (0 DP), 1 Decimal Place, 2 etc.)

Mathematical Note:

Allowing for any value space (say, numbers from 2.7 to 3.81 with values of 3 decimal places):

First, compute the size of the space (max - min). For a range of 2 to 7, the size would be 7-2 = 5.

We then add an extra buffer so that Floor() has an equal chance of hitting the top of our value space. This will be 1 * 10 ^ (-numDecimalPlaces).

We then multiply Rnd() by the size of the space to get a random position within our value space.

Then add that value to our minValue, and Floor() to the appropriate level of precision.

Function:

Public Function RandList(ByVal minValue As Double, ByVal maxValue As Double, ByVal targetSum As Double, Optional ByVal numDecimalPlaces As Long = 0) As Double()

    sumTotal = WorksheetFunction.Floor(sumTotal, numDecimalPlaces) '/ In Case, e.g. the total is 100.24 but we're only working in whole numbers

    Dim sumList() As Double
    ReDim sumList(1 To 1)

    Dim remainder As Double
    remainder = targetSum

    Dim valueSpace As Double
    valueSpace = maxValue - minValue + 1 * 10 ^ (-numDecimalPlaces) '/ 1 * 10 ^ (-numDecimalPlaces) is our Floor() buffer so we can still hit the top of the value space.

    Dim i As Long
    Dim rndNum As Double
    Do Until remainder <= 0
        i = i + 1
        ReDim Preserve sumList(1 To i)
        rndNum = WorksheetFunction.Floor(minValue + (Rnd() * valueSpace), numDecimalPlaces)
        sumList(i) = rndNum
        remainder = remainder - rndNum
    Loop
    sumList(i) = sumList(i) + remainder

    RandList = sumList

End Function

Which you can then call like so:

Public Sub DescriptiveName()

    Dim sumList() As Double
    sumList = RandList(0, 9, 100)

    '/ Stuff to print sumList goes here

End Sub

N.B. Thanks to @arcadeprecinct and @raystafarian for suggestions and improvements.

StackExchange Code Review Q#132075, answer score: 8