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

x
Solved

# Take out the dupes

Posted on 2007-10-15
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
Question by:wjshore
• 4
• 2
• 2
• +2
11 Comments

LVL 66

Expert Comment

ID: 20081535
{wild guess}

Public Sub ChooseRandomScreens()

Randomize

'The rest of your code goes here

End Sub
0

LVL 93

Expert Comment

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

ID: 20081745
Thanks, Jim.  Randomize should be there, but it produces the same dupe-contaminated results.
0

Author Comment

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

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

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

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

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

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

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

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

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.