• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 322
  • Last Modified:

Take out the dupes

The following bit of VB6 code is supposed to produce a list of values for the variables M1 thru M20.  The numbers should be 0 thru 19 in random order.  Yet it now gives several sets of duplicate numbers.  Can anyone see how this needs to be changed so that no duplicates are produced?


Public Sub ChooseRandomScreens()

  'Select 20 Title screen positions at random
 
    Dim iScreens(19) As Double
    Dim i As Integer
    Dim j As Integer
    Dim iTest As Integer
    Dim ListLength As Integer
    Dim bFound As Boolean
   
  ' ListLength = number of Form1.Title() screens
    ListLength = 20
    For i = 0 To 19
    bFound = False
        Do
            iTest = 1 + Int(Rnd * ListLength)
            For j = 0 To i - 1
            If iTest = Rnd(i) Then
                bFound = True
                Exit For
            End If
            Next j
        Loop Until bFound = False
        iScreens(i) = iTest
    Next i
   
   M1 = iScreens(0)
   M2 = iScreens(1)
   M3 = iScreens(2)
   M4 = iScreens(3)
   M5 = iScreens(4)
   M6 = iScreens(5)
   M7 = iScreens(6)
   M8 = iScreens(7)
   M9 = iScreens(8)
   M10 = iScreens(9)
   M11 = iScreens(10)
   M12 = iScreens(11)
   M13 = iScreens(12)
   M14 = iScreens(13)
   M15 = iScreens(14)
   M16 = iScreens(15)
   M17 = iScreens(16)
   M18 = iScreens(17)
   M19 = iScreens(18)
   M20 = iScreens(19)

   
End Sub
0
wjshore
Asked:
wjshore
  • 4
  • 2
  • 2
  • +2
2 Solutions
 
Jim HornMicrosoft SQL Server Developer, Architect, and AuthorCommented:
{wild guess}

Public Sub ChooseRandomScreens()

Randomize

'The rest of your code goes here

End Sub
0
 
Patrick MatthewsCommented:
Hello wjshore,

Public Sub ChooseRandomScreens()

  'Select 20 Title screen positions at random
 
    Dim iScreens(19) As Double
    Dim coll As Collection
    Dim Counter As Long
    Dim Grab As Long

    Set coll = New Collection    

    For Counter = 0 To 19
        Coll.Add Counter
    Next

    Randomize
    For Counter = 0 To 19
        Grab = Int(Rnd * coll.Count)
        iScreens(Counter) = coll(Grab)
        coll.Remove Grab
    Next
    Set coll = Nothing

   M1 = iScreens(0)
   M2 = iScreens(1)
   M3 = iScreens(2)
   M4 = iScreens(3)
   M5 = iScreens(4)
   M6 = iScreens(5)
   M7 = iScreens(6)
   M8 = iScreens(7)
   M9 = iScreens(8)
   M10 = iScreens(9)
   M11 = iScreens(10)
   M12 = iScreens(11)
   M13 = iScreens(12)
   M14 = iScreens(13)
   M15 = iScreens(14)
   M16 = iScreens(15)
   M17 = iScreens(16)
   M18 = iScreens(17)
   M19 = iScreens(18)
   M20 = iScreens(19)

   
End Sub


Regards,

Patrick
0
 
wjshoreAuthor Commented:
Thanks, Jim.  Randomize should be there, but it produces the same dupe-contaminated results.
0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
wjshoreAuthor Commented:
Patrick, again thanks for contributing.  When I run your code, I get "script out of range" error at
                              iScreens(Counter) = coll(Grab)

Can you see the problem?  Thanks.
0
 
GrahamSkanRetiredCommented:
Things seem to have got a bit muddled.
This is your code re-arranged

Public Sub ChooseRandomScreens()

  'Select 20 Title screen positions at random
 
    Dim iScreens(19) As Double
    Dim i As Integer
    Dim j As Integer
    Dim iTest As Integer
    Dim ListLength As Integer
    Dim bFound As Boolean
  ' ListLength = number of Form1.Title() screens
    ListLength = 20
    For i = 0 To 19
        Do
            bFound = False
            iTest = 1 + Int(Rnd * ListLength)
            For j = 0 To i - 1
                If iTest = iScreens(j) Then
                    bFound = True
                    Exit For
                End If
            Next j
        Loop Until bFound = False
        iScreens(i) = iTest
    Next i
 
0
 
GrahamSkanRetiredCommented:
There were just a couple of changes.

    For i = 0 To 19
        Do
            bFound = False '                                    <------Moved from before the Do statement
            iTest = 1 + Int(Rnd * ListLength)
            For j = 0 To i - 1
                If iTest = iScreens(j) Then ' <------------- Changed from iTest = 1 + Int(Rnd * ListLength)
                    bFound = True
                    Exit For
                End If
            Next j
        Loop Until bFound = False
        iScreens(i) = iTest
    Next i
0
 
Patrick MatthewsCommented:
Hm, try this:



Public Sub ChooseRandomScreens()

  'Select 20 Title screen positions at random
 
    Dim iScreens(19) As Double
    Dim coll As Collection
    Dim Counter As Long
    Dim Grab As Long

    Set coll = New Collection    

    For Counter = 0 To 19
        Coll.Add Counter
    Next

    Randomize
    For Counter = 1 To 20
        Grab = Int(Rnd * coll.Count) + 1
        iScreens(Counter - 1) = coll(Grab)
        coll.Remove Grab
    Next
    Set coll = Nothing

   M1 = iScreens(0)
   M2 = iScreens(1)
   M3 = iScreens(2)
   M4 = iScreens(3)
   M5 = iScreens(4)
   M6 = iScreens(5)
   M7 = iScreens(6)
   M8 = iScreens(7)
   M9 = iScreens(8)
   M10 = iScreens(9)
   M11 = iScreens(10)
   M12 = iScreens(11)
   M13 = iScreens(12)
   M14 = iScreens(13)
   M15 = iScreens(14)
   M16 = iScreens(15)
   M17 = iScreens(16)
   M18 = iScreens(17)
   M19 = iScreens(18)
   M20 = iScreens(19)

   
End Sub
0
 
wjshoreAuthor Commented:
GrahamSkan:  Eureka!  Dupes gone.  The routine produces numbers from 1 to 20.  Which is the right line to tweek to produce 0 to 19?  Thanks.
0
 
wjshoreAuthor Commented:
Thank you Graham and Patrick!!  When I removed the '1+' from Graham's ' iTest = 1 + Int(Rnd * ListLength)', both solutions worked equally well.
0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
How about something like?

' -------------------------
'  Form1
' -------------------------
Option Explicit

Public M1 As Integer
Public M2 As Integer
Public M3 As Integer
Public M4 As Integer
Public M5 As Integer
Public M6 As Integer
Public M7 As Integer
Public M8 As Integer
Public M9 As Integer
Public M10 As Integer
Public M11 As Integer
Public M12 As Integer
Public M13 As Integer
Public M14 As Integer
Public M15 As Integer
Public M16 As Integer
Public M17 As Integer
Public M18 As Integer
Public M19 As Integer
Public M20 As Integer

Private Sub Command1_Click()
    ChooseRandomScreens
End Sub

Private Sub ChooseRandomScreens()
    Static randomized As Boolean
    If Not randomized Then
        Debug.Print "Randomizing"
        Randomize
        randomized = True
    End If

    Dim i As Integer
    Dim arrNumbers() As Integer
    arrNumbers = generateSet(0, 19, 20)
   
    For i = 1 To 20
        CallByName Me, "M" & i, VbLet, arrNumbers(i - 1)
    Next i
   
    For i = 1 To 20
        Debug.Print "M" & i & " = " & CallByName(Me, "M" & i, VbGet)
    Next i
End Sub

Private Function generateSet(ByVal rangeMin As Integer, ByVal rangeMax As Integer, ByVal setSize As Integer) As Integer()
    Dim rangesize As Integer
    Dim rangeSet() As Integer
   
    Dim i As Integer
    Dim r As Byte
    Dim swapWith As Integer
    Dim tempInt As Integer
   
    ' compute the size of the range
    rangesize = rangeMax - rangeMin + 1
   
    ' make sure the input parameters make sense...
    If rangeMax < rangeMin Then
        MsgBox "rangeMax must be greater than or equal to rangeMin"
        Exit Function
    End If
    If setSize <= 0 Or setSize > rangesize Then
        MsgBox "setsize must be greater than zero and less than or equal to the range size"
        Exit Function
    End If
   
    ' resize our array
    ReDim rangeSet(rangesize - 1)
   
    ' build the range set
    For i = 0 To rangesize - 1
        rangeSet(i) = i + rangeMin
    Next i
   
    ' shuffle the range set 7 times
    For r = 1 To 7
        ' for each item in the set,
        ' pick another item and
        ' swap them
        For i = 0 To rangesize - 1
            swapWith = Int(rangesize * Rnd)
            tempInt = rangeSet(i)
            rangeSet(i) = rangeSet(swapWith)
            rangeSet(swapWith) = tempInt
        Next i
    Next r
                 
    ' return the selected set (first setSize elements)
    ReDim Preserve rangeSet(setSize - 1)
    generateSet = rangeSet
End Function
0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
By the way, my generateSet() function above would work well for your previous question:

    Dim arrNumbers() As Integer
    arrNumbers = generateSet(1, 20, 4) ' pick four numbers from 1 to 20
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 4
  • 2
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now