Results 1 to 2 of 2

Thread: Create Random Number Generator VBA

  1. #1
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10

    Lightbulb Create Random Number Generator VBA

    Hi All,

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

    Code:
    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
    Last edited by Admin; 12-01-2011 at 10:09 AM. Reason: Improved version
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Here is another improved version.

    Code:
    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
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Get Random List :
    By Rajan_Verma in forum Rajan Verma's Corner
    Replies: 0
    Last Post: 06-06-2013, 07:53 PM
  2. Dynamic Worksheet Generator Sheet Copy
    By mfaisalrazzak in forum Excel Help
    Replies: 2
    Last Post: 03-01-2013, 05:38 PM
  3. Unique Random Number In Ascending Order
    By marreco in forum Excel Help
    Replies: 8
    Last Post: 11-04-2012, 04:15 PM
  4. Random Unique Number Generator Excel VBA
    By Excel Fox in forum Excel and VBA Tips and Tricks
    Replies: 5
    Last Post: 10-18-2012, 01:00 PM
  5. Generate random numbers in Excel
    By Mahesh in forum Excel Help
    Replies: 3
    Last Post: 10-06-2011, 11:24 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •