Create Random Number Generator VBA

[Admin]

Hi All,

Here is a UDF to create random number generator. Option to generate unique values as well(by default it's TRUE).


Option Explicit
Function RANDOMNUMGENERATOR(ByVal MinVal As Long, ByVal MaxVal As Long, _
ByVal HowMany As Long, Optional ByVal UNIQUE As Boolean = True)



'// Created by : Krishnakumar @ ExcelFox.com

Dim i As Long, Diff As Long
Dim RNG() As Long, n As Long
Dim AC, RowsCount As Long
Dim ColCount As Long

On Error Resume Next
Set AC = Application.Caller
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0: GoTo 2:
End If
On Error GoTo 0
If TypeName(AC) <> "Range" Then Exit Function

RowsCount = AC.Rows.Count
ColCount = AC.Columns.Count

RANDOMNUMGENERATOR = CVErr(xlErrNum)

If RowsCount > 1 And ColCount <> 1 Then Exit Function
If RowsCount <> 1 And ColCount > 1 Then Exit Function
If RowsCount >= 1 And ColCount = 1 Then
If HowMany <> RowsCount Then Exit Function
End If
If ColCount >= 1 And RowsCount = 1 Then
If HowMany <> ColCount Then Exit Function
End If
2:
Diff = MaxVal - MinVal
RANDOMNUMGENERATOR = Empty
If UNIQUE Then
With CreateObject("scripting.dictionary")
Do While .Count <= HowMany - 1
Randomize
.Item(MinVal + Int(Rnd * Diff)) = Empty
Loop
RANDOMNUMGENERATOR = Application.Transpose(.keys)
End With
Else
n = 1
Do While n <= HowMany
RNG(n) = MinVal + Int(Rnd * Diff)
n = n + 1
Loop
RANDOMNUMGENERATOR = Application.Transpose(RNG)
End If


End Function

To use select a range, for e.g. if you want to generate 10 random numbers,
select A1:A10 > apply the formula > hit CTRL + SHIFT + ENTER

[Admin]

Here is another improved version.


Option Explicit
Function RANDOMNUMGENERATOR(ByVal MinVal As Long, ByVal MaxVal As Long, _
Optional HowMany As Long, Optional ByVal UNIQUE As Boolean = True)

'// Created by : Krishnakumar @ ExcelFox.com

Dim Diff As Long, Tot As Long
Dim RNG() As Long, n As Long
Dim AC, RowsCount As Long
Dim tmp, ColCount As Long
Dim r As Long, c As Long


On Error Resume Next
Set AC = Application.Caller
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0: GoTo 2:
End If
On Error GoTo 0

If TypeName(AC) <> "Range" Then
RANDOMNUMGENERATOR = CVErr(xlErrRef)
Exit Function
End If

Application.Volatile

RowsCount = AC.Rows.Count
ColCount = AC.Columns.Count
Tot = RowsCount * ColCount
If HowMany <> Tot Then HowMany = Tot

ReDim RNG(1 To RowsCount, 1 To ColCount)

2:
Diff = MaxVal - MinVal
RANDOMNUMGENERATOR = Empty
If UNIQUE Then
With CreateObject("scripting.dictionary")
Do While .Count <= HowMany - 1
Randomize
.Item(MinVal + Int(Rnd * Diff)) = Empty
Loop
tmp = .keys
For r = 1 To RowsCount
For c = 1 To ColCount
RNG(r, c) = tmp(n)
n = n + 1
Next
Next
RANDOMNUMGENERATOR = RNG 'Application.Transpose(.keys)
End With
Else
For r = 1 To RowsCount
For c = 1 To ColCount
RNG(r, c) = MinVal + Int(Rnd * Diff)
Next
Next
RANDOMNUMGENERATOR = RNG
End If

End Function

Use like

Array enter

=RANDOMNUMGENERATOR(1,100)

in A1:B10 or

A1:A10 or

A1:J1