[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Take out the dupes

Posted on 2007-10-15
11
Medium Priority
?
319 Views
Last Modified: 2010-04-30
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
Comment
Question by:wjshore
  • 4
  • 2
  • 2
  • +2
11 Comments
 
LVL 66

Expert Comment

by:Jim Horn
ID: 20081535
{wild guess}

Public Sub ChooseRandomScreens()

Randomize

'The rest of your code goes here

End Sub
0
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 20081723
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
 

Author Comment

by:wjshore
ID: 20081745
Thanks, Jim.  Randomize should be there, but it produces the same dupe-contaminated results.
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 

Author Comment

by:wjshore
ID: 20081781
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
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 20081793
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
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 1000 total points
ID: 20081822
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
 
LVL 93

Assisted Solution

by:Patrick Matthews
Patrick Matthews earned 1000 total points
ID: 20081849
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
 

Author Comment

by:wjshore
ID: 20081891
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
 

Author Comment

by:wjshore
ID: 20081974
Thank you Graham and Patrick!!  When I removed the '1+' from Graham's ' iTest = 1 + Int(Rnd * ListLength)', both solutions worked equally well.
0
 
LVL 86

Expert Comment

by:Mike Tomlinson
ID: 20082034
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
 
LVL 86

Expert Comment

by:Mike Tomlinson
ID: 20082049
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

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Today, the web development industry is booming, and many people consider it to be their vocation. The question you may be asking yourself is – how do I become a web developer?
If you are a mobile app developer and especially develop hybrid mobile apps then these 4 mistakes you must avoid for hybrid app development to be the more genuine app developer.
The viewer will be introduced to the member functions push_back and pop_back of the vector class. The video will teach the difference between the two as well as how to use each one along with its functionality.
Screencast - Getting to Know the Pipeline
Suggested Courses
Course of the Month18 days, 15 hours left to enroll

834 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question