Abstract
If you want to generate non-repeating random integers between two given values I suggest to use my UDF sbRandInt:
You can also generate random integers which may appear repeatedly up to lRept times:
Appendix – sbRandInt Code
Please read my Disclaimer.
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.de/sbrandint_en/
'Source (DE): http://www.berndplumhoff.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
Please read my Disclaimer.
sbRandInt.xlsm [44 KB Excel file, open and use at your own risk]