RANDTOTAL function

**bambino_32** · 07-22-2010, 03:46 PM

hi all
I would like to create multi cell array formula which will give random numbers totaling specified number. I have started, but I really don't know how to tell function that it's been entered on 6 or 10 cells.

Function RANDTOTAL(Total As Long, Bottom As Integer, Top As Integer) As Variant()

DON'T KNOW HOW TO START((((

End Function

**Andrew-R** · 07-22-2010, 04:07 PM

Well there's your problem, you haven't closed your brackets properly. Try ...

Function RANDTOTAL(Total As Long, Bottom As Integer, Top As Integer) As Variant()

DON'T KNOW HOW TO START(((())))

End Function

Seriously I don't think this can be done in the form of a worksheet function - it would generate all kinds of logic problems.

It would be easy (well, easier) to write a Sub that distributed random numbers totalling a given value across a selected range of cells, but there are big problems with the mathematics as well. Say, for example, you wanted to generate random numbers from 1-10 totalling 20. If the first number generated is 10 and the second one 9 then your third number isn't going to be very random.

You could solve this problem by looping through, regenerating random numbers until the total happens to be the target ... so in the example above we've got a 10, a 9 and then we generate a 4, total 23 (bust!), so we regenerate the fist random number and get an 8 (total 21), then regenerate the second random number and get a 7 (total=19) and then regenerate the 3rd and get a 5 - BINGO!

Of course that could, theoretically, loop forever and it only works if you tell it how many random numbers you want in your total.

In short, it's dead hard.

**shg** · 07-22-2010, 04:23 PM

Try this:

Function RandTot(iTot As Long, iMin As Long, iMax As Long, _
                 Optional bVol As Boolean = False) As Variant
    ' shg 2010
    Dim nNum        As Long
    Dim i           As Long
    Dim ad()        As Double
    Dim dd          As Double
    Dim iTry        As Long

    If bVol Then Application.Volatile
    With Application.Caller
        If .Rows.Count > 1 And .Columns.Count > 1 Then
            RandTot = "Enter as row or column vector only!"
            Exit Function
        End If
        nNum = .Count
    End With

    If iMax < iMin Or iTot < nNum * iMin Or iMax > iTot Then
        RandTot = CVErr(xlErrValue)
        Exit Function
    End If

    ReDim ad(1 To nNum - 1)
    Randomize

    For i = 1 To nNum - 1
        ad(i) = RandBetw(iMin, iMax)
    Next i

    With WorksheetFunction
        Do
            iTry = iTry + 1
            If iTry > 200 Then
                RandTot = "Time-out"
                Exit Function
            End If

            Select Case iTot - .Sum(ad)
                Case Is < iMin
                    i = .Match(.Max(ad), ad, 0)
                Case Is > iMax
                    i = .Match(.Min(ad), ad, 0)
                Case Else
                    ReDim Preserve ad(1 To nNum)
                    ad(nNum) = iTot - .Sum(ad)
                    RandTot = ad
'                    Debug.Print iTry
                    Exit Function
            End Select

            ad(i) = RandBetw(iMin, iMax)
        Loop
    End With
End Function

Function RandBetw(iMin, iMax) As Long
    RandBetw = (Rnd * (iMax - iMin) + Rnd * (iMax - iMin) + Rnd * (iMax - iMin)) / 4 + iMin
End Function

Then for example, select A1:A10, and enter this formula:

=TRANSPOSE(RandTot(10000, 500, 1500))

The formula MUST be confirmed with Ctrl+Shift+Enter.

The Min and Max values have to reasonably center around the average value (here, 1000).