Generate list of unique random numbers using VBA in Microsoft Excel

In this article, we will create a custom function to generate a list of unique and random numbers between the specified ranges.

In this example, we can run the macro by clicking the “Submit” button. Before running the macro, we have to input values for four parameter. We have supply the lower limit value in cell C12, upper limit in cell C13, number of unique random required in cell C14 and destination address were output is required in cell C15.

 

ArrowMain

 

Logic explanation

We have created “UniqueRandomNumbers” custom function to generate list of unique and random numbers. This function takes the required number, lower limit and upper limit as input parameters.

We have created “TestUniqueRandomNumbers” macro to call “UniqueRandomNumbers” custom function. This macro is executed by clicking the “Submit” button. This macro takes the user input value from the range C12 to C15.

ArrowOutput

Code explanation

i = CLng(Rnd() * (ULimit - LLimit) + LLimit)

Above formula is used to create the random number between the defined upper and lower limit. Rnd() function creates a random number between 0 and 1.

Range(Selection, Selection.Offset(Counter - 1, 0)).Value = _

Application.Transpose(RandomNumberList)

Above code is used to transpose the output of the array and assign the output to the specified destination.

 

Please follow below for the code

Option Explicit

Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As Long) As Variant

'Declaring variables
Dim RandColl As Collection
Dim i As Long
Dim varTemp() As Long

'Validation check for the value specified by the user
If NumCount < 1 Then
    UniqueRandomNumbers = "Number of unique random number required is less than 1"
    Exit Function
End If

If LLimit > ULimit Then
    UniqueRandomNumbers = "Specified lower limit is greater than specified upper limit"
    Exit Function
End If

If NumCount > (ULimit - LLimit + 1) Then
    UniqueRandomNumbers = "Number of required unique random number is greater than maximum number of unique number that can exists between lower limit and upper limit"
    Exit Function
End If

'Creating new object of collection
Set RandColl = New Collection

Randomize

Do

    On Error Resume Next
    
    'Calculating the random number that exists between the lower and upper limit
    i = CLng(Rnd() * (ULimit - LLimit) + LLimit)
    
    'Inserting the  unique random number in the collection
    RandColl.Add i, CStr(i)
    
    On Error GoTo 0

'Looping until collection have items equal to numCount
Loop Until RandColl.Count = NumCount

ReDim varTemp(1 To NumCount)

'Assigning value of the items in the collection to varTemp array
For i = 1 To NumCount
    varTemp(i) = RandColl(i)
Next i

UniqueRandomNumbers = varTemp

Set RandColl = Nothing

Erase varTemp

End Function

Sub TestUniqueRandomNumbers()

'Declare variables
Dim RandomNumberList As Variant
Dim Counter As Long, LowerLimit As Long, UpperLimit As Long
Dim Address As String

'Getting the values input by the user
Counter = Range("C14").Value
LowerLimit = Range("C12").Value
UpperLimit = Range("C13").Value
Address = Range("C15").Value

'Calling custom function UniqueRandomNumbers
RandomNumberList = UniqueRandomNumbers(Counter, LowerLimit, UpperLimit)

'Selecting the destination
Range(Address).Select

'Assigning the value in the destination
Range(Selection, Selection.Offset(Counter - 1, 0)).Value = _
    Application.Transpose(RandomNumberList)
    
End Sub

 

If you liked this blog, share it with your friends on Facebook. Also, you can follow us on Twitter and Facebook.

We would love to hear from you, do let us know how we can improve our work and make it better for you. Write to us at info@exceltip.com

Users are saying about us...

  1. "I had modified the example of the unique random number returns. as below

    Function UniqueRandomNumbers(NumCount As Long, ULimit As Long) As Variant
    Dim RandColl As Collection, i As Long, varTemp() As Long
    UniqueRandomNumbers = False
    If NumCount < 1 Then Exit Function
    If NumCount < ULimit Then Exit Function
    Set RandColl = New Collection
    Randomize
    Do
    On Error Resume Next
    i = CLng(Rnd * ULimit)
    RandColl.Add i, CStr(i)
    On Error GoTo 0
    Loop Until RandColl.Count = NumCount
    ReDim varTemp(1 To NumCount)
    For i = 1 To NumCount
    varTemp(i) = RandColl(i)
    Next i
    Set RandColl = Nothing
    UniqueRandomNumbers = varTemp
    Erase varTemp
    End Function

    Sub TestUniqueRandomNumbers()
    Dim varrRandomNumberList As Variant
    varrRandomNumberList = UniqueRandomNumbers(1000, 999)
    Range(Cells(3, 1), Cells(1000 + 2, 1)).Value = _
    Application.Transpose(varrRandomNumberList)
    End Sub

    But I found that I can generate the numcount for more than 1000. Actually i want to create a list of number which from 0 till 999 completely (total 10,000 numbers).

    Pls help"

  2. I still get numbers repeated using the user defined function. How do I enter the formula to create unique random numbers between 1 and 24?

  3. "I need some help with the function below. It works pretty well when de QTD argument is less then 5462. Above this nummer it returns #VALUE! and I want to be able to set QTD as big as possible, for instance 50000. The output is a array, and I don't really know if there is any limit for it. This function generates number according to a Normal distribution with average Media and Standard Deviation Vol. QTD is the number of normal numbers. I appreciate your help on this problem.

    ----------------------------x----------------------------------

    Function Numeros_Normais(QTD, Media, Vol) As Variant

    ReDim Vetor(1 To QTD) As Double

    For i = 1 To QTD

    start:
    rand1 = 2 * Rnd - 1
    rand2 = 2 * Rnd - 1
    S1 = rand1 ^ 2 + rand2 ^ 2
    If S1 > 1 Then GoTo start
    S2 = Sqr(-2 * Log(S1) / S1)
    Erro = rand1 * S2

    Vetor(i) = Media + Erro * Vol

    Next

    Numeros_Normais = Vetor()

    End Function"

  4. "I had modified the example of the unique random number returns. as below

    Function UniqueRandomNumbers(NumCount As Long, ULimit As Long) As Variant
    Dim RandColl As Collection, i As Long, varTemp() As Long
    UniqueRandomNumbers = False
    If NumCount < 1 Then Exit Function
    If NumCount < ULimit Then Exit Function
    Set RandColl = New Collection
    Randomize
    Do
    On Error Resume Next
    i = CLng(Rnd * ULimit)
    RandColl.Add i, CStr(i)
    On Error GoTo 0
    Loop Until RandColl.Count = NumCount
    ReDim varTemp(1 To NumCount)
    For i = 1 To NumCount
    varTemp(i) = RandColl(i)
    Next i
    Set RandColl = Nothing
    UniqueRandomNumbers = varTemp
    Erase varTemp
    End Function

    Sub TestUniqueRandomNumbers()
    Dim varrRandomNumberList As Variant
    varrRandomNumberList = UniqueRandomNumbers(1000, 999)
    Range(Cells(3, 1), Cells(1000 + 2, 1)).Value = _
    Application.Transpose(varrRandomNumberList)
    End Sub

    But I found that I can generate the numcount for more than 1000. Actually i want to create a list of number which from 0 till 999 completely (total 10,000 numbers). "

  5. I still get numbers repeated using the user defined function. How do I enter the formula to create unique random numbers between 1 and 24?

  6. "I need some help with the function below. It works pretty well when de QTD argument is less then 5462. Above this nummer it returns #VALUE! and I want to be able to set QTD as big as possible, for instance 50000. The output is a array, and I don't really know if there is any limit for it. This function generates number according to a Normal distribution with average Media and Standard Deviation Vol. QTD is the number of normal numbers. I appreciate your help on this problem.

    ----------------------------x----------------------------------

    Function Numeros_Normais(QTD, Media, Vol) As Variant

    ReDim Vetor(1 To QTD) As Double

    For i = 1 To QTD

    start:
    rand1 = 2 * Rnd - 1
    rand2 = 2 * Rnd - 1
    S1 = rand1 ^ 2 + rand2 ^ 2
    If S1 > 1 Then GoTo start
    S2 = Sqr(-2 * Log(S1) / S1)
    Erro = rand1 * S2

    Vetor(i) = Media + Erro * Vol

    Next

    Numeros_Normais = Vetor()

    End Function"

  7. I would like to run a unique random date function in VBA but I am running into issues when I attempt to do so. Is this possible? Can someone assist me in doing so if it is?

Leave a Reply

Your email address will not be published. Required fields are marked *

Terms and Conditions of use

The applications/code on this site are distributed as is and without warranties or liability. In no event shall the owner of the copyrights, or the authors of the applications/code be liable for any loss of profit, any problems or any damage resulting from the use or evaluation of the applications/code.

Visit Us On TwitterVisit Us On FacebookVisit Us On Youtube