generate random 4 digit number in range between 0000 and 9999

[m3nl]

Hi fellow VBA'ers,

Ik have the following question, I need a vba module/function that generates a random 4 digit number in the range between 0000 and 9999 and the result can not be an already existing number within this range.

Preferably for excel.

Hoping someone already developed a peice of code for this.

TIA and HAPPY 2005,

Michel
The Netherlands

 

[jcrater]

from Excel help:

To produce random integers in a given range, use this formula:
Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
Here, upperbound is the highest number in the range, and lowerbound is the lowest number in the range.

if you want a 4-digit number, wrap the result with the format function, like Format(Result,"0000").

Finally, it sounds like you don't want to reuse any numbers, so you'll have to come up with some method of comparing each newly-generated number with existing ones; however, you didn't give enough info as to how this would be used. Are you calling it once and producing many random numbers, or calling it many times to generate a single number?

 

[m3nl]

Jcrater> Thanks for yuor reply...I can wrap ur formula in my custom function.

I need this to create unique 4 digit access codes, 1 at a time. Created codes need to be unique, once created I store them in a MySQL database for future reference and newly created codes need to be compared to the ones already in the database to make sure they are unique.

Hope this answeres ur question.

Happy 2005,

Michel
The Netherlands

 

[DrBowes]

I suggest you associate random numbers with numbers 0-9999, then sort in the order of the random numbers. This will give those numbers in random order.

Simplest way would do this in a worksheet but you could do it with an array if you prefer (probably). Then load into your databse all at once.

Somthing like


Sub RND1()

For 0 = 1 To 9999

Cells(i, 1).Value = i

Cells(i, 2).Value = Rnd

Next i

Columns("A:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


End Sub

 

[Zathras]

You didn't actually say how many codes you need or how many existing codes you have. Here is a routine that provides for existing codes to be checked as well as generating new ones within a given range (in case you want the smallest 4-digit number to be 1000, for example)

Sub GenerateRandomNumbers(FirstNum As Integer, _
          LastNum As Integer, ARange As Range, _
          Optional ExistingNumbers As Range = Nothing)
Dim i As Integer
Dim n As Integer
Dim nExistingNumberCount As Integer
Dim nTotalNumbersNeeded As Integer
Dim oColl As Collection
  Set oColl = New Collection
  
  If Not ExistingNumbers Is Nothing Then
    With ExistingNumbers
      For i = 1 To .Count
        oColl.Add Item:=.Cells(i, 1), key:=CStr(.Cells(i, 1))
      Next i
    End With
  End If
  
  nExistingNumberCount = oColl.Count
  nTotalNumbersNeeded = nExistingNumberCount + ARange.Rows.Count
  On Error Resume Next
  While oColl.Count < nTotalNumbersNeeded
    n = RandomNumber(FirstNum, LastNum)
    oColl.Add Item:=n, key:=CStr(n)
  Wend
  
  Application.ScreenUpdating = False
  For i = nExistingNumberCount + 1 To oColl.Count
    ARange.Cells(i - nExistingNumberCount, 1).Value = oColl.Item(i)
  Next i
  Application.ScreenUpdating = True
  
  Set oColl = Nothing
End Sub

Function RandomNumber(FirstNum As Integer, _
             LastNum As Integer) As Integer
  RandomNumber = Int((LastNum - FirstNum + 1) * Rnd()) + FirstNum
End Function

Here are some routines for testing and examples (start with a blank column "A"):

Sub Test1()
  Randomize (42)
  GenerateRandomNumbers 1000, 9999, Range("A1:A999")
End Sub

Sub Test2()
  Randomize (4242)
  GenerateRandomNumbers 1000, 9999, Range("A1000:A1999"), Range("A1:A999")
End Sub

Sub Test3()
  Randomize (1000)
  GenerateRandomNumbers 1000, 9999, Range("A2000:A2999"), Range("A1:A1999")
End Sub