VBA Adding to 5 Digit Unique Random Numbers

Stephen_IV

Well-known Member
Joined
Mar 17, 2003
Messages
1,103
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
In column B I have 5 Digit Unique Random Numbers that were pre-assigned. I use the code below that makes 5 Digit Unique Random Numbers. The problem is that since I already have pre-assigned ID numbers in column B is there a way to adapt to this code to Look at Column B and add those numbers into the Unique random digits so that I could have a unique list generated in column A minus those numbers already assigned in column B.

Thanks In Advance Stephen

Sub PINCreate()
Dim RndNo As Long
Dim Test As Long
Dim i As Long
For i = 2 To 5500
Randomize
Do
RndNo = Int((99999 - 10000 + 1) * Rnd + 10000)
On Error Resume Next
Test = Application.Match(RndNo, Range(Cells(1, 1), Cells(i, 1)), 0)
If Err.Number = 13 Then
GoTo FoundUnique
Err.Clear
End If
Loop
FoundUnique:
Cells(i, 1) = RndNo
Next i
End Sub
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

Oorang

Well-known Member
Joined
Mar 4, 2005
Messages
2,071
I expect this ought to do it:
If you wanted to get a 7 digit pin excluding values in column b, use like so =getpin(B:B,7)
Mind the circular references.
Code:
Option Explicit
Option Compare Binary
Option Base 0
Public Function GetPIN(ExcludeRange As Excel.Range, Length As Long) As Long
    Dim rng As Excel.Range
    Dim cll As Excel.Range
    Dim sVal As String
    Dim lVals() As Long
    Dim lNum As Long
    Dim lIndex As Long
    Dim lUprBnd As Long
    Const lLwrBnd_c As Long = 0
    Const lOffset_c As Long = 1
    'Eliminate unused cells in reference:
    Set rng = Excel.Intersect(ExcludeRange.Parent.UsedRange, ExcludeRange)
    If Not rng Is Nothing Then
        ReDim lVals(rng.Cells.Count - lOffset_c)
        'As a number may be reused, load clls to memory for
        'quicker reaccess:
        For Each cll In rng.Cells
            sVal = cll.Value
            If VBA.IsNumeric(sVal) Then
                lVals(lIndex) = CLng(sVal)
                lIndex = lIndex + lOffset_c
            End If
        Next
    End If
    lUprBnd = lIndex - lOffset_c
    Do
        'Get Random Number
        lNum = GetNum(Length)
        'Make Sure Number is unused:
        For lIndex = lLwrBnd_c To lUprBnd
            If lNum = lVals(lIndex) Then Exit For
        Next
    Loop Until lIndex > lUprBnd
    GetPIN = lNum
End Function
Private Function GetNum(Length As Long) As Long
    Dim lIndex As Long
    Dim sReturnVal As String
    Const lLwrBnd_c As Long = 2
    Const lZero_c As Long = 0
    Const lOne_c As Long = 1
    Const lNine_c As Long = 9
    For lIndex = lLwrBnd_c To Length
        'Update System Clock:
        VBA.DoEvents
        'Use Random Seed:
        VBA.Randomize
        sReturnVal = sReturnVal & CStr(VBA.Int((lNine_c + lOne_c) * VBA.Rnd))
    Next
    'Prevent leading zeros from being generated:
    sReturnVal = CStr(VBA.Int(lNine_c * (VBA.Rnd + lOne_c))) & sReturnVal
    GetNum = CLng(sReturnVal)
End Function
 

Stephen_IV

Well-known Member
Joined
Mar 17, 2003
Messages
1,103
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Thank you so much it worked great.
 

Forum statistics

Threads
1,181,607
Messages
5,930,881
Members
436,764
Latest member
avalladarez

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top