Function uniqRandBetween(ByVal lo As Double, ByVal hi As Double, _
Optional exclude)
' USAGE: select 2-dimensional range and
' array-enter (press ctrl+shift+Enter instead of Enter)
' formula with uniqRandBetween(lowInt,highInt,exclude),
' where "exclude" is number, array constant or range of
' numbers to be excluded
Dim nr As Long, nc As Long, n As Long
Dim i As Long, j As Long, x As Long
Dim nExc As Long, ve As Variant, wf As Variant
Dim s As String
s = Application.Caller.Address
Randomize
Set wf = WorksheetFunction
' round lo up and hi down if not integers
lo = WorksheetFunction.RoundUp(lo, 0)
hi = Int(hi)
n = hi - lo + 1
' collect exclusion list, if any
If Not IsMissing(exclude) Then
Select Case TypeName(exclude)
Case "Double":
ReDim exc(1 To 1) As Double
exc(1) = wf.Round(exclude, 0)
nExc = 1
Case "Variant()":
On Error Resume Next
nr = UBound(exclude, 1)
nc = UBound(exclude, 2)
If Err > 0 Then
' exclude is 1-dim array
ReDim exc(1 To nr) As Double
For i = 1 To nr
exc(i) = wf.Round(exclude(i), 0)
Next
nExc = nr
Else
' exclude is 2-dim array
ReDim exc(1 To nr * nc) As Double
nExc = 0
For i = 1 To nr: For j = 1 To nc
nExc = nExc + 1
exc(nExc) = wf.Round(exclude(i, j), 0)
Next j, i
End If
On Error GoTo 0
Case "Range":
nExc = exclude.Count
ReDim exc(1 To nExc) As Double
If nExc = 1 Then
exc(1) = wf.Round(exclude, 0)
Else
ve = exclude
nr = UBound(ve, 1)
nc = UBound(ve, 2)
nExc = 0
For i = 1 To nr: For j = 1 To nc:
nExc = nExc + 1
exc(nExc) = wf.Round(ve(i, j), 0)
Next j, i
End If
Case Else:
uniqRandBetween = CVErr(xlErrValue)
Exit Function
End Select
End If
' determine array-formula range dimensions
' (and number of random numbers)
With Application.Caller
nr = .Rows.Count
nc = .Columns.Count
End With
' generate list of numbers
ReDim v(1 To n) As Double
If nExc = 0 Then
For i = lo To hi: v(i) = i: Next
Else
n = 0
For i = lo To hi
If IsError(Application.Match(i, exc, 0)) Then
n = n + 1
v(n) = i
End If
Next
End If
If n < nr * nc Then
uniqRandBetween = CVErr(xlErrValue)
Exit Function
End If
' generate nr-by-nc array of unique random numbers
ReDim res(1 To nr, 1 To nc) As Double
For i = 1 To nr: For j = 1 To nc
x = Int(n * Rnd) + 1
res(i, j) = v(x)
If x <> n Then v(x) = v(n)
n = n - 1
Next j, i
uniqRandBetween = res
End Function