generating, randomly (0-82), a 660 cell range to SUM to 42000

[BMJ]

"generating, randomly (0-82), a 660 cell range to SUM to 42000"

I've been looking around for code or an easy way to do this but have not had any luck yet.

If anyone knows how to set this up in excel or openoffice or can explain how to change some of the code that exists for similar problems, please let me know.

hmm...

Thanks,

 

[shg]

Ignoring the upper limit,

Function RandLen(dTot As Double, _
                 Optional dMin As Double = 0#, _
                 Optional ByVal iSig As Long = 0, _
                 Optional bVolatile As Boolean = False) As Variant
    ' shg 2011
    ' UDF wrapper for adRandLen
    If bVolatile Then Application.Volatile
    With Application.Caller
        If .Rows.Count > 1 And .Columns.Count > 1 Then
            RandLen = CVErr(xlErrRef)
        ElseIf .Columns.Count > 1 Then
            RandLen = adRandLen(dTot, .Columns.Count, dMin, iSig)
        Else
            RandLen = WorksheetFunction.Transpose(adRandLen(dTot, .Rows.Count, dMin, iSig))
        End If
    End With
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

E.g. select A1:A660, and array-enter

=RandLen(42000, 0, 0)