Article 37 – VBA – Generating Unique (Non-repeating) Random Numbers Efficiently

This article is about how to generate unique or non-repeating random numbers given two limits. Hence, if lower limit is 10 and maximum limit is 100, hence, it should generate random numbers between 10 and 100.

The algorithm to ensure uniqueness is following –

1. Given lower limit and upper limit, generate all numbers and populate an array. Now, this array contains all numbers between lower limit and upper limit sequentially. Hence, in case of 10 to 100, it will contain entries 10, 11, 12, …..99,100.
2. Next is to shuffle the array randomly using Fisher Yates algorithm so that the array contains the numbers 10, 11, 12…99,100 in a random order.
3. Now, you can retrieve the numbers from this array as per need. Say, if you need 20 random numbers, just retrieve first 20 entries from the array which was shuffled.

Below is a VBA code implementation of the above algorithm. Using this code as the base, you can implement your code as per your need. For example, all or limited Constant can be passed as parameters to this Sub and you can modify the code to accept the parameters.

1. Make a backup of your workbook.
2. Open your workbook and ALT+F11
3. Locate your Workbook name in Project Explorer Window
4. Right click on your workbook name > Insert > Module
5. Copy paste the Macro code given and change as per your requirement.
6. Go back to your Workbook and ALT+F8 to display Macro Window
7. Run your Macro from here
8. Delete you Macro if the Macro was needed to be run only once.
9. Otherwise save your file as .xlsm if you intend to reuse Macro again.

' ''''''' Vijay A Verma (eforexcel.com) ''''''''
' Generate non-duplicating random number between a range
Sub GenerateRandoms()
    ' Define the minimum, maximum of the range and how many random
    ' numbers are needed
    Const Min As Long = 10000
    Const Max As Long = 99999
    Const HowMany As Long = 10
    ' Define the column where randoms are wanted and starting row as well
    Const StartRow As Long = 5
    Const Col As String = "B"
    Dim LastRow As Long
    Dim Ws As Worksheet
    Dim i As Long, j As Long, Temp As Long, Number As Long
    Dim Arr
    ' Error Checking
    If Max = 0 Then
        MsgBox "Maximum number can not be 0"
        Exit Sub
    End If
    If HowMany = 0 Then
        MsgBox "Number of required Randoms can not be 0"
        Exit Sub
    End If
    If Min > Max Then
        MsgBox "Minimum is more than Maximum"
        Exit Sub
    End If
    If Max - Min + 1 < HowMany Then
        MsgBox "Number of Randoms required should not be more than Max - Min + 1"
        Exit Sub
    End If
    ' If your worksheet is not Sheet1, change here appropriately
    Set Ws = Worksheets("Sheet1")
    Application.ScreenUpdating = False
    Number = Max - Min + 1
    ReDim Arr(1 To Number, 1 To 1)
    ' Generate all possible number between Min and Max
    For i = Min To Max
        Arr(i - Min + 1, 1) = i
    Next i
    Randomize
    ' Shuffle the array generated above randomly
    For i = 1 To Number
        j = Int((Number - i + 1) * Rnd) + i
        Temp = Arr(i, 1)
        Arr(i, 1) = Arr(j, 1)
        Arr(j, 1) = Temp
    Next i
    'Copy into the Worksheet those many records which are requested
    Ws.Range(Col & StartRow & ":" & Col & StartRow + HowMany - 1) = Arr
    Application.ScreenUpdating = True
End Sub