Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

how do you exclude a random number after it has been use it a loop? 2

Status
Not open for further replies.

purecrazz

Technical User
Jul 24, 2002
3
US
how do you exclude a random number after it has been use it a loop? so when you continue the loop, it won't display it again.
 
Here is some code for you.

Private Sub cmdRandom_Click()
Dim arr(5) As String
Dim str As String
Dim iX As Long
Dim iY As Long

Randomize

For iX = 0 To 5
For iY = 0 To iX
If arr(iY) = str Then
str = CStr(Int(Rnd * 6))
iY = -1
End If
Next
arr(iX) = str
Next
End Sub

The second loop is the one that checks for duplicates and reset the loop if it finds a duplicate with the line

iY = -1

Hope this helps. [spin] If you choose to battle wits with the witless be prepared to lose.
[machinegun][hammer]
 
foda's approasch can work, however it can also become quite time consuming, as it can taks many itterations to find a value as the process nears the end. You may be filling the array of 6th number to fill in the array(5) but all values except (perhaps) 3 are already used. It coule taks several itterations for the routine to return the unused value (3). In the trivial example, this is inconsequential. In a larger sense, it may easily become a limiting factor, such as filling the array of several hundred where the last value MUST match the only GAP in the sequence.


Code:
Public Function basShuffle(N2Shuff As Integer) As Variant

    'Michael Red    7/25/02 Tek-Tips thread222-321406

    Dim Shuf() As ShuffleType
    Dim Idx As Integer
    Dim Jdx() As Variant
    Dim Sorted As Boolean

    ReDim Shuf(N2Shuff)
    ReDim Jdx(N2Shuff)

    Idx = 1                     'Easier for User & Can Use (0) for sorting
    While Idx <= N2Shuff        'Add a Value to Shuffle and Its RELATIVE order
        With Shuf(Idx)
            .ToShuff = Idx
            .ShuffOr = Rnd()
        End With
        Idx = Idx + 1
    Wend

    'Do any desired sort here.  Sort the &quot;TYPE&quot; on the random Number
    Idx = 1
    Sorted = True           'Assume the BEST
    While Sorted = True
        While Idx <= N2Shuff - 1
            Sorted = True           'Assume the BEST

            If (Shuf(Idx).ShuffOr > Shuf(Idx + 1).ShuffOr) Then
                'Swap

                Shuf(0).ToShuff = Shuf(Idx).ToShuff                 'Save Current
                Shuf(0).ShuffOr = Shuf(Idx).ShuffOr

                Shuf(Idx).ToShuff = Shuf(Idx + 1).ToShuff           'Move Next to Current
                Shuf(Idx).ShuffOr = Shuf(Idx).ShuffOr

                Shuf(Idx + 1).ToShuff = Shuf(0).ToShuff             'Move Saved to Next
                Shuf(Idx + 1).ShuffOr = Shuf(0).ShuffOr

                Sorted = False
            End If
            
            Idx = Idx + 1
        Wend
    Wend

    Idx = 1
    While Idx <= N2Shuff

        Jdx(Idx) = Shuf(Idx).ToShuff

        Idx = Idx + 1
    Wend

    'basShuffle = Jdx()

    Idx = 1
    While Idx <= N2Shuff
        Debug.Print Idx, Jdx(Idx)
        Idx = Idx + 1
    Wend

End Function
MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over
 
Thank you foada for pointing me to this thread...

Dim Shuf() As ShuffleType 'where do you get this? -- Just trying to help... LOL [ponder]
 
Although not specifically declared here, the type &quot;Shuff&quot; is easily infered from the code. It consist of:

Type ShufffleType

[Tab]ToShuff as Long '(Idx)
[Tab]ShuffOr as Single 'Rnd()
End Type

This must be included at the module level


MichaelRed
m.red@att.net

Searching for employment in all the wrong places
 
Here's a simple way to do it. It involves creating an array (bucket) with all the possible values in it, &quot;shaking&quot; it, and then &quot;drawing&quot; them out one at a time.

Option Explicit
Dim intBucket() As Integer

Private Sub Command1_Click()

Dim intCounter As Integer

Shake_Bucket Val(Text1.Text)

For intCounter = 1 To Val(Text1.Text)
Debug.Print intBucket(intCounter)
Next

End Sub

Public Sub Shake_Bucket(intSize As Integer)
Dim intCounter As Integer
Dim intWhichBucket As Integer
Dim intTemp As Integer

ReDim intBucket(1 To intSize)

Randomize Timer

For intCounter = 1 To intSize
intBucket(intCounter) = intCounter
Next

For intCounter = 1 To intSize
intWhichBucket = Int(Rnd * intSize + 1)
intTemp = intBucket(intCounter)
intBucket(intCounter) = intBucket(intWhichBucket)
intBucket(intWhichBucket) = intTemp
Next

End Sub

The advantage here is that there is no need to &quot;search&quot; for used values so you don't get any kind of exponential slow-down for using large numbers. No matter how large the range, you just go once thru to load it, and once thru to get the next value.

later.
greg.
 
Here are two solutions I developed:

1. Use a 2 dimensional array....
Code:
for i = 0 to ubound(myArr,1)
  myArr(i,0) = RND()
  myArr(i,1) = -1
next
for i = 0 to ubound(myArr,1)
  numHigher = 0
  thisVal = myArr(i,0)
  for j = 0 to ubound(myArr,1)
    if thisVal > myArr(j,0) then
      numHigher = numHigher + 1
    elseif thisVal = myArr(j,0) then
      myArr(j,0) = myArr(j,0) + .0000000000001
    end if
  next
  numArr(i,1) = numHigher
next

2. Use a one-dimensional array and reset the random number for the lowest random number to 1 then continue through whole array....
Code:
for i = 0 to ubound(myArr)
  myArr(i) = RND()
next
for i = 0 to ubound(myArr)
  lowestVal = myArr(0)
  lowestPos = 0
  for j = 0 to uBound(myArr)
    if myArr(j) < lowestVal then
      lowestVal = myArr(j)
      lowestPos = j
    end if
  next
  myArr(lowestPos) = i + 1
next
-- Just trying to help... LOL [ponder]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top