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