I am a supporter ofSt. Joseph's hospice. If you find this site useful or if it helped you, consider a small donation toSt. Joseph's, please. Information onSt. Joseph's  It is fairly easy to create a loaded die, let us say on average the 6 should appear twice as often as all the other numbers 1 thru 5: Enter into A1: =MIN(INT(RAND()*7+1),6) But what if you want to create 7 rolls of this die and all numbers between 1 and 5 should appear exactly once and 6 exactly twice? Here is my general solution: Function sbExactRandHistogrm(ldraw As Long, _            dmin As Double, _            dmax As Double, _            vWeight As Variant) As Variant'Creates an exact histogram distribution for ldraw draws'within range dmin:dmax. This range is divided into'vWeight.count classes. Each class has weight vWeight(i)'reflecting the probability of occurrence of a value'within the class.'If weights can't be achieved exactly for ldraw draws the'largest remainder method will be applied to minimize'absolute error. This function calls (needs) sbRoundToSum.'Reverse("moc.LiborPlus.www") PB V0.2 21-Sep-2019 (C) (P) by Bernd PlumhoffDim i As Long, j As Long, n As LongDim vW As VariantDim dSumWeight As Double, dR As Double'Application.Volatile 'Uncomment if you likeWith Application.WorksheetFunctionvW = .Transpose(vWeight)On Error GoTo Errhdli = vW(1) 'Throw error in case of horizontal arrayOn Error GoTo 0n = UBound(vW)ReDim dWeight(1 To n) As DoubleReDim dSumWeightI(0 To n) As DoubleReDim vR(1 To ldraw) As VariantdSumWeight = 0#For i = 1 To n    If vW(i) < 0# Then 'A negative weight is an error        sbExactRandHistogrm = CVErr(xlErrValue)        Exit Function    End If    'Calculate sum of all weights    dSumWeight = dSumWeight + vW(i)Next iIf dSumWeight = 0# Then    'Sum of weights has to be greater zero    sbExactRandHistogrm = CVErr(xlErrValue)    Exit FunctionEnd IfFor i = 1 To n    'Align weights to number of draws    dWeight(i) = CDbl(ldraw) * vW(i) / dSumWeightNext ivW = sbRoundToSum(dWeight, 0)For j = 1 To ldraw    dSumWeight = 0#    dSumWeightI(0) = 0#    For i = 1 To n        'Calculate sum of all weights        dSumWeight = dSumWeight + vW(i)        'Calculate sum of weights till i        dSumWeightI(i) = dSumWeight    Next i        dR = dSumWeight * Rnd        i = n    Do While dR < dSumWeightI(i)        i = i - 1    Loop        vR(j) = dmin + (dmax - dmin) * (CDbl(i) + _            (dR - dSumWeightI(i)) / vW(i + 1)) / CDbl(n)    vW(i + 1) = vW(i + 1) - 1#    Next jsbExactRandHistogrm = vRExit FunctionErrhdl:'Transpose variants to be able to address'them with vW(i), not vW(i,1)vW = .Transpose(vW)Resume NextEnd WithEnd Function