Option Explicit

'xlErrDiv0                   [#DIV/0!]               CVErr(xlErrDiv0)
'xlErrNA                     [#N/A]                  CVErr(xlErrNA)
'xlErrName                   [#NAME?]                CVErr(xlErrName)
'xlErrNull                   [#NULL!]                CVErr(xlErrNull)
'xlErrNum                    [#NUM!]                 CVErr(xlErrNum)
'xlErrRef                    [#REF!]                 CVErr(xlErrRef)
'xlErrValue                  [#VALUE!]               CVErr(xlErrValue)

Function sbRandInt(lMin As Long, _
    lMax As Long, _
    Optional lRept As Long = 1, _
    Optional ByVal lCount As Long = 0 _
    ) As Variant
'Returns lCount random integers between lMin and lMax, each one
'occurring zero to lRept times. lMax - lMin + 1 must be greater
'or equal to lCount. If called from worksheet and lCount = 0
'then number of selected cells specify lCount.
'Error values:
'#NUM!   - lRept is less than 1
'#REF!   - lCount is greater than (lMax - lMin + 1) * lRept
'#VALUE! - lCount is less than 1
'Source (EN): http://www.sulprobil.com/sbrandint_en/
'Source (DE): http://www.bplumhoff.de/sbrandint_de/
'(C) (P) by Bernd Plumhoff 06-Dec-2021 PB V1.01
Static bRandomized As Boolean
Dim i As Long, j As Long
Dim lRnd As Long, lRange As Long
Dim lrow As Long, lcol As Long
Const CLateInitFactor = 50

If lRept < 1 Then
    sbRandInt = CVErr(xlErrNum)
    Exit Function
End If

lRange = (lMax - lMin + 1) * lRept

With Application.Caller
    If TypeName(Application.Caller) = "Range" And lCount = 0 Then
        lCount = .Count
        If lCount > lRange Then
            sbRandInt = CVErr(xlErrRef)
            Exit Function
        End If
        ReDim lr(1 To .Rows.Count, 1 To .Columns.Count) As Long
    ElseIf lCount < 1 Then
        sbRandInt = CVErr(xlErrValue)
        Exit Function
    ElseIf lCount > lRange Then
        sbRandInt = CVErr(xlErrRef)
        Exit Function
    Else
        ReDim lr(1 To lCount, 1 To 1) As Long
    End If
End With

If Not bRandomized Then
    Randomize
    bRandomized = True
End If

ReDim lT(1 To lRange) As Long
'If we have a huge range of possible random integers and a comparably
'small number of draws, i.e. if (lMax - lMin) * lRept >> lCount
'then we can save some runtime with late initialization.
If lRange / lCount < CLateInitFactor Then
    For i = 1 To lRange
        lT(i) = Int((i - 1) / lRept) + lMin
    Next i
End If

i = 1
If lRange / lCount < CLateInitFactor Then
    For lrow = 1 To UBound(lr, 1)
        For lcol = 1 To UBound(lr, 2)
            lRnd = Int(((lRange - i + 1) * Rnd) + 1)
            lr(lrow, lcol) = lT(lRnd)
            lT(lRnd) = lT(lRange - i + 1)
            i = i + 1
        Next lcol
    Next lrow
Else
    j = lMin: If lMin <= 0 And lMax >= 0 Then j = 1
    For lrow = 1 To UBound(lr, 1)
        For lcol = 1 To UBound(lr, 2)
            lRnd = Int(((lRange - i + 1) * Rnd) + 1)
            If lT(lRnd) = 0 Then
                lr(lrow, lcol) = Int((lRnd - 1) / lRept) + j
            Else
                lr(lrow, lcol) = lT(lRnd)
            End If
            If lT(lRange - i + 1) = 0 Then
                lT(lRnd) = Int((lRange - i) / lRept) + j
            Else
                lT(lRnd) = lT(lRange - i + 1)
            End If
            i = i + 1
        Next lcol
    Next lrow
    'If lRange includes zero we need to shift result array
    If lMin <= 0 And lMax >= 0 Then
        For lrow = 1 To UBound(lr, 1)
            For lcol = 1 To UBound(lr, 2)
                lr(lrow, lcol) = lr(lrow, lcol) + lMin - 1
            Next lcol
        Next lrow
    End If
End If

sbRandInt = lr

End Function