Unique Random Numbers using VBA
Here's a method of guaranteeing unique integer random numbers. Inline comments describe the method.
Function UniuqeRandom(Mn As Long, Mx As Long, Sample As Long) As Long()
Dim dat() As Long
Dim i As Long, j As Long
Dim tmp As Long
' Input validation checks here
If Mn > Mx Or Sample > (Mx - Mn + 1) Then
' declare error to suit your needs
Exit Function
End If
' size array to hold all possible values
ReDim dat(0 To Mx - Mn)
' Fill the array
For i = 0 To UBound(dat)
dat(i) = Mn + i
Next
' Shuffle array, unbiased
For i = UBound(dat) To 1 Step -1
tmp = dat(i)
j = Int((i + 1) * Rnd)
dat(i) = dat(j)
dat(j) = tmp
Next
'original biased shuffle
'For i = 0 To UBound(dat)
' tmp = dat(i)
' j = Int((Mx - Mn) * Rnd)
' dat(i) = dat(j)
' dat(j) = tmp
'Next
' Return sample
ReDim Preserve dat(0 To Sample - 1)
UniuqeRandom = dat
End Function
use it like this
Dim low As Long, high As Long
Dim rng As Range
Dim dat() As Long
Set rng = Range(Cells(1, 1), Cells(1, 1).End(xlToRight))
dat = UniuqeRandom(low, high, rng.Columns.Count)
rng.Offset(1, 0) = dat
Note: see this Wikipedia article regarding shuffle bias
The edit fixed one source of bias. The inherent limitations of Rnd
(based on a 32 bit seed) and Modulo bias remain.
I see you have an accepted answer, but for whatever it's worth here is my stab at this question. This one uses a boolean function instead of numerical arrays. It's very simple yet fast. The advantage of it, which I'm not saying is perfect, is an effective solution for numbers in a long range because you only ever check the numbers you have already picked and saved and don't need a potentially large array to hold the values you have rejected so it won't cause memory problems because of the size of the array.
Sub UniqueRandomGenerator()
Dim N As Long, MaxNum As Long, MinNum As Long, Rand As Long, i As Long
MinNum = 1 'Put the input of minimum number here
MaxNum = 100 'Put the input of maximum number here
N = MaxNum - MinNum + 1
ReDim Unique(1 To N, 1 To 1)
For i = 1 To N
Randomize 'I put this inside the loop to make sure of generating "good" random numbers
Do
Rand = Int(MinNum + N * Rnd)
If IsUnique(Rand, Unique) Then Unique(i, 1) = Rand: Exit Do
Loop
Next
Sheet1.[A1].Resize(N) = Unique
End Sub
Function IsUnique(Num As Long, Data As Variant) As Boolean
Dim iFind As Long
On Error GoTo Unique
iFind = Application.WorksheetFunction.Match(Num, Data, 0)
If iFind > 0 Then IsUnique = False: Exit Function
Unique:
IsUnique = True
End Function