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