“Few things are harder to put up with than the annoyance of a good example.” [Mark Twain]
Abstract
Sometimes you need to create random integers without repetition.
If you need 20 random integers within range 1 .. 100, select 20 adjacent cells, enter =UniqRandInt(100) as array formula. If you need them in range 100 .. 199, enter =UniqRandInt(100)+99, in general:
=UniqRandInt(Endvalue - Startvalue + 1) + Startvalue - 1
If your random integers may occur up to 6 times, use =UniqRandInt(100,6). Please notice that the constant ALLOW_REPETITION has to be set to True.
If you need this feature in VBA programming environment then use VBUniqRandInt() as shown below.
Example
Select cells A1:B3, type =UniqRandInt(6) and enter with CTRL + SHIFT + ENTER (as array formula):
Appendix – UniqRandInt Code
Please read my Disclaimer.
Option Explicit
'If lRange >> n then set LATE_INITIALISATION to true
'For example if lRange=1000000 and if 1000 cells are selected (n=1000)
#Const LATE_INITIALISATION = False
'If random integers may occur more than once, allow repetitions
#Const ALLOW_REPETITION = True
#If ALLOW_REPETITION Then
Function UniqRandInt(ByVal lRange As Long, _
Optional lMaxOccurence As Long = 1) As Variant
#Else
Function UniqRandInt(ByVal lRange As Long) As Variant
#End If
'Returns n unique (=non-repeating) random integers within 1..lRange,
'lRange >= n if n cells in a worksheet have been selected and the
'function has been entered as array formula (CTRL+SHIFT+ENTER).
'Set ALLOW_REPETITION = True and call with lMaxOccurences > 1 if
'random integers may occur more than once.
'Source (EN): http://www.sulprobil.com/uniqrandint_en/
'Source (DE): http://www.bplumhoff.de/uniqrandint_de/
'(C) (P) by Bernd Plumhoff 26-Jul-2020 PB V1.03
Static bRandomized As Boolean
Dim vA As Variant
Dim vR As Variant
Dim i As Long
Dim lr As Long
Dim lrow As Long
Dim lcol As Long
'Application.Volatile '(Un-)Comment if you like
If Not bRandomized Then
Randomize
bRandomized = True
End If
If TypeName(Application.Caller) <> "Range" Then
UniqRandInt = CVErr(xlErrRef)
Exit Function
End If
#If ALLOW_REPETITION Then
If lMaxOccurence < 1 Then
UniqRandInt = CVErr(xlErrNum)
Exit Function
End If
lRange = lRange * lMaxOccurence
#End If
If Application.Caller.Count > lRange Then
UniqRandInt = CVErr(xlErrValue)
Exit Function
End If
ReDim vR(1 To Application.Caller.Rows.Count, _
1 To Application.Caller.Columns.Count)
ReDim vA(1 To lRange)
#If Not LATE_INITIALISATION Then
For i = 1 To lRange
#If ALLOW_REPETITION Then
vA(i) = Int((i - 1) / lMaxOccurence) + 1
#Else
vA(i) = i
#End If
Next i
#End If
i = 1
For lrow = 1 To UBound(vR, 1)
For lcol = 1 To UBound(vR, 2)
lr = Int(((lRange - i + 1) * Rnd) + 1)
#If LATE_INITIALISATION Then
If vA(lr) = 0 Then
#If ALLOW_REPETITION Then
vR(lrow, lcol) = Int((lr - 1) / _
lMaxOccurence) + 1
#Else
vR(lrow, lcol) = lr
#End If
Else
#End If
vR(lrow, lcol) = vA(lr)
#If LATE_INITIALISATION Then
End If
If vA(lRange - i + 1) = 0 Then
#If ALLOW_REPETITION Then
vA(lr) = Int((lRange - i + 1 - 1) / _
lMaxOccurence) + 1
#Else
vA(lr) = lRange - i + 1
#End If
Else
#End If
vA(lr) = vA(lRange - i + 1)
#If LATE_INITIALISATION Then
End If
#End If
i = i + 1
Next lcol
Next lrow
UniqRandInt = vR
End Function
#If ALLOW_REPETITION Then
Function VBUniqRandInt(lCount As Long, _
ByVal lRange As Long, _
Optional lMaxOccurence As Long = 1) As Variant
#Else
Function VBUniqRandInt(lCount As Long, _
ByVal lRange As Long) As Variant
#End If
'Returns lCount unique (=non-repeating) random integers within
'1..lRange. lRange has to be >= lCount.
'Set ALLOW_REPETITION = True and call with lMaxOccurences > 1 if
'random integers may occur more than once.
'Source (EN): http://www.sulprobil.com/uniqrandint_en/
'Source (DE): http://www.bplumhoff.de/uniqrandint_de/
'(C) (P) by Bernd Plumhoff 26-Jul-2020 PB V1.03
Static bRandomized As Boolean
Dim vA As Variant
Dim vR As Variant
Dim i As Long
Dim lr As Long
'Application.Volatile '(Un-)Comment if you like
If Not bRandomized Then
Randomize
bRandomized = True
End If
#If ALLOW_REPETITION Then
If lMaxOccurence < 1 Then
VBUniqRandInt = CVErr(xlErrNum)
Exit Function
End If
lRange = lRange * lMaxOccurence
#End If
If lCount > lRange Then
VBUniqRandInt = CVErr(xlErrValue)
Exit Function
End If
ReDim vR(1 To lCount)
ReDim vA(1 To lRange)
#If Not LATE_INITIALISATION Then
For i = 1 To lRange
#If ALLOW_REPETITION Then
vA(i) = Int((i - 1) / lMaxOccurence) + 1
#Else
vA(i) = i
#End If
Next i
#End If
For i = 1 To lCount
lr = Int(((lRange - i + 1) * Rnd) + 1)
#If LATE_INITIALISATION Then
If vA(lr) = 0 Then
#If ALLOW_REPETITION Then
vR(i) = Int((lr - 1) / lMaxOccurence) + 1
#Else
vR(i) = lr
#End If
Else
#End If
vR(i) = vA(lr)
#If LATE_INITIALISATION Then
End If
If vA(lRange - i + 1) = 0 Then
#If ALLOW_REPETITION Then
vA(lr) = Int((lRange - i + 1 - 1) / _
lMaxOccurence) + 1
#Else
vA(lr) = lRange - i + 1
#End If
Else
#End If
vA(lr) = vA(lRange - i + 1)
#If LATE_INITIALISATION Then
End If
#End If
Next i
VBUniqRandInt = vR
End Function
Download
Please read my Disclaimer.
UniqRandInt.xlsm [21 KB Excel file, open and use at your own risk]