Results 1 to 3 of 3

Thread: Ok..I give up ! How to make this work?

  1. #1

    Thread Starter
    Member
    Join Date
    Jul 1999
    Posts
    40

    Post

    'help..this is far from working..all I do is get in a loop
    'what I am trying to do is create a random number between 1 and 47
    'have no duplicates, sort, paste to text boxes.
    'just a dumb lotto generation scheme
    '

    Dim sArray(1 To 7) ' total numbers selected
    Dim ICheck7(1 To 47) ' numbers range from 1 to 47


    'load the iCheck7 array with the 47 available numbers

    Dim a
    For a = 1 To 47
    ICheck7(a) = a
    Next a

    Dim i
    Dim iCounter As Integer 'counter to end loop

    Randomize

    For i = 1 To 7

    'must be a number between 1 and 47
    sArray(i) = Int((47 - 1 + 1) * Rnd + 1)

    'start here again if a duplicate is found

    Again:

    'do until I have all 7 numbers compared and placed in array

    Do While iCounter < 8
    'check the current sArray indexed number agains the icheck7 array
    ' numbers (1 to 47)

    For a = 1 To 47
    If sArray(i) = ICheck7(a) Then

    ' if a number matches 1 to 47 then keep the number
    'change th iCheck7 number to 0 so it can't be matched again
    'increment the counter

    sArray(i) = sArray(i)
    ICheck7(a) = "0"
    iCounter = iCounter + iCounter

    Else
    'if no match is found I already have the number so create a new one
    'and then run trhought the check again...do until I get a good number

    Randomize
    sArray(i) = Int((47 - 1 + 1) * Rnd + 1)
    End If

    GoTo Again:
    Next a
    Loop

    Next i
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'from here down is not a problem
    'sort the arrays

    Call BubbleSortNumbers(sArray)

    Text7.Text = sArray(1)
    Text8.Text = sArray(2)
    Text9.Text = sArray(3)
    Text10.Text = sArray(4)
    Text11.Text = sArray(5)
    Text12.Text = sArray(6)
    Text13.Text = sArray(7)

  2. #2
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,175

    Post

    This will give you 7 non-repeating numbers between 1 and 47.
    Code:
        Dim nTry As Integer
        Dim nAddCount As Integer
        Dim bFound As Integer
        Dim nDummy As Integer
        Dim MyCollection As New Collection
        
        Randomize
        
        Do Until nAddCount = 7
            nTry = Int((47 - 1 + 1) * Rnd + 1)
            On Error Resume Next
            nDummy = MyCollection.Item(CStr(nTry))
            bFound = (Err = 0)
            If bFound Then
                Err.Clear
            Else
                MyCollection.Add nTry, CStr(nTry)
                nAddCount = nAddCount + 1
            End If
        Loop
    You'll probably need to modify your BubbleSortNumbers to accept the collection rather than your array, or you could do this before you call the bubble sort.
    Code:
    For nAddCount = 0 to MyCollection.Count
        ICheck7(nAddCount) = MyCollection.Item(nAddCount)
    Next nAddCount
    If you need more help you could EMail me if you want to.
    ------------------
    Marty

    [This message has been edited by MartinLiss (edited 12-08-1999).]

  3. #3
    I'm about to be a PowerPoster! Joacim Andersson's Avatar
    Join Date
    Jan 1999
    Location
    Sweden
    Posts
    14,649

    Post

    Your GoTo statement ALWAYS loops back to the Again label. BTW your a very bad boy using a GoTo statement. Here's an other solution:

    Dim sArray(1 To 7)
    Dim iCheck7(1 To 47)
    Dim a As Integer
    Dim i As Integer
    Dim iTemp As Integer

    For a = 1 To 47
    iCheck7(a) = a
    Next

    For a = 1 To 7
    i = Int(Rnd * (48 - a)) + a
    iTemp = iCheck7(a)
    iCheck7(a) = iCheck7(i)
    iCheck7(i) = iTemp
    sArray(a) = iCheck7(a)
    Next

    Call BubbleSortNumbers(sArray)

    Text7.Text = sArray(1)
    Text8.Text = sArray(2)
    Text9.Text = sArray(3)
    Text10.Text = sArray(4)
    Text11.Text = sArray(5)
    Text12.Text = sArray(6)
    Text13.Text = sArray(7)

    Good luck!

    ------------------
    Joacim Andersson
    joacim@programmer.net
    joacim@yellowblazer.com
    www.YellowBlazer.com



Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width