Link to home
Start Free TrialLog in
Avatar of wjshore
wjshore

asked on

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
Avatar of Jim Horn
Jim Horn
Flag of United States of America image

{wild guess}

Public Sub ChooseRandomScreens()

Randomize

'The rest of your code goes here

End Sub
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
Avatar of wjshore
wjshore

ASKER

Thanks, Jim.  Randomize should be there, but it produces the same dupe-contaminated results.
Avatar of wjshore

ASKER

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.
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
 
ASKER CERTIFIED SOLUTION
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of wjshore

ASKER

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.
Avatar of wjshore

ASKER

Thank you Graham and Patrick!!  When I removed the '1+' from Graham's ' iTest = 1 + Int(Rnd * ListLength)', both solutions worked equally well.
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
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