Visual Basic Helper Routines

Pure VB: Preventing Duplicates in a Random Number Array
Posted:   Monday October 18, 1999
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   Rick Rothstein, Ken Ensign
Related:     Pure VB: Generating a Random Array of Unique Numbers

Although my preference for creating a randomized array of numbers is the method listed under Related above, there may be occasions where you want to use brute force to create a specific random array on the fly. The code shown here takes two values -- one representing the number of unique values you require, and the second representing the size of the pool to draw from, e.g. generate 12 unique numbers from 1 to 50 (as shown here).

The code is copiously commented, resulting in the output shown in the illustration.  You'll notice that when the third number was generated it matched an already-generated value in position 1. The code then generated a new value (38 in this case) and assigned that as the #3 item. Similarly, the code detected dupes for items 9 and 11, and regenerated new values for those.


 BAS Module Code

 Form Code
Toss a command button (Command1) and a list box (List1) onto a form, along with the following code:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
Private Sub Form_Load()

   Command1.Caption = "Random Numbers w/ No Dupes"
End Sub

Private Sub Command1_Click()

   Dim nCount As Long
   Dim tmp As Long
   Dim cnt As Long
   Dim gotIt As Boolean
   Dim numDistinctValues As Long
   Dim numUpperValueMax As Long

  'the number of unique numbers you want
  '(in a quiz, this might be the number
  'of questions you intend to ask)
   numDistinctValues = 12
  'the size of the pool to draw the
  'unique numbers from (in a quiz,
  'number of questions available)
   numUpperValueMax = 50

   ReDim nArray(1 To numDistinctValues)


  'seed the random number generator to
  'assure a unique set of numbers each
  'time the routine is run.  The current
  'system time is fine for this purpose.
   Randomize CSng(TimeValue(Time))

  'begin count to get numbers
   For nCount = 1 To numDistinctValues
     'reset flag
      gotIt = False
      Do Until gotIt = True
        'generate a number between 1 and
         tmp = Int(Rnd(1) * numUpperValueMax) + 1
        'if its the first number just add it
        'and set the gotIt flag
         If nCount = 1 Then
            nArray(nCount) = tmp
            gotIt = True
           'begin a loop that only ends
           'once a new valid number is
              'is it already in the list?
               For cnt = 1 To nCount
                 'compare the current value
                 '(tmp) to know values
                  If tmp = nArray(cnt) Then
                    'it must be there, so
                    'generate another number
                    'to try and exit the loop
                    'show the duplicate number
                     List1.AddItem "  " & nCount & vbTab & tmp & " < this is a dupe of #" & cnt
                    'try to generate a different number
                     tmp = Int(Rnd(1) * numUpperValueMax) + 1
                    'show the new number
                     List1.AddItem "  " & nCount & vbTab & "new #" & nCount & " >" & tmp
                    'found a match, so redo whole loop 
                    'again with new tmp value!
                     gotIt = False
                     Exit For
                       gotIt = True  'no match
                    End If
            Loop Until gotIt = True
        End If
        If gotIt = True Then
         'add to the array
          nArray(nCount) = tmp
         'show the added number
          List1.AddItem nCount & vbTab & nArray(nCount)
         End If

End Sub


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter