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.
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.
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
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.
This is absolutely magnificent!!! VAU???
Thank You Very Much!!
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?
"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"
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?
"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). "
"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"
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?
"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"