VBA Adding to 5 Digit Unique Random Numbers

[Stephen_IV]

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

 

[Oorang]

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.

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]

Thank you so much it worked great.