roulette simulator

[jammoca]

I would like to have a list of student names, and a command button, that when pressed, begins highlighting the names one at a time ( starting at the top, moving down through the list, then starting at the top again, moving down through the list again, etc etc) each time the time that each name is highlighted gets longer and longer, effectively like a roulette wheel.

Eventually, one of the names would remain highlighted.

When the command button is pressed again, the 'roulette' highlighting process starts again, and eventually another name would be highlighted.

Is this possible ?

I already have a 'random student selector' program operating that returns a student name randomly and without ever returning a name twice, but it lacks the drama and suspense this 'roulette' method might provide.

 

[PaddyD]

"I already have a 'random student selector' program operating..."

Why not post it up to provide a bit more context...

 

[jammoca]

I'd be happy to display the code I'm using, but it bears no resemblence to what I am trying to do, so I don't wish to make that the focus of my query.

I'll provide my code in a separate topic.

So, does anyone have an idea that might get me started in creating the 'roulette' style highlighting of student names ?

 

[Sal Paradise]

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulette()
    Dim i, j As Integer
    Dim intSlowDown As Integer
    Dim intStudents As Integer
    Dim intRotations As Integer
    Dim intStopsOn As Integer
    
    intStudents = Range("A1").End(xlDown).Row
    
    intRotations = Int((10 * Rnd) + 1)
    intStopsOn = Int((intStudents * Rnd) + 1)
        
    For j = 1 To intRotations
        For i = 1 To Range("A1").End(xlDown).Row
            intSlowDown = intSlowDown + 1
            Cells(i, 1).Interior.ColorIndex = 6
            If i = 1 Then
                Cells(10, 1).Interior.ColorIndex = xlNone
            Else
                Cells(i - 1, 1).Interior.ColorIndex = xlNone
            End If
            
            If j = intRotations And i = intStopsOn Then
                MsgBox (Cells(i, 1).Value & " has been chosen")
                Exit Sub
            End If
            
            Sleep intSlowDown * 10
        Next i
    Next j
    
End Sub

The part in red determines the amount of loops you want to go through the list. Bear in mind that my sleep code will make it get progressively longer the more loops there are. Feel free to make it 1-4 or something if you'd like, or to change the sleep code so that it goes fast until the last loop, or whatever.

At any rate, it works.

 

[jammoca]

Where have you got this pasted and what are you using to initialise it, as I currently have it pasted in the sheet 1 coding window, but when I press 'Run' it has finished all its loops by the time the sheet displays itself.

I am quite new to using code as you can tell.

 

[Weaver]

If you want some drama and suspense, use the code you have but wave a loaded pistol about the place while you run it...

Actually, I'd be tempted to animate an arrow alongside the list, but either way, will the whole list appear on one screen or will the page have to scroll?

Also, does your list change much? If not, there might be other software more suited to this task, like Flash, for instance.

 

[jammoca]

good point .. I'm dabbling in flash as well, so might give that a go

Thanks

 

[Weaver]

I did something similar to this a long time ago in Director (precursor to Flash) where I had a rotating object. I randomly decided the angle it was to stop at (so I knew the result before anim started, but nobody else needed to know this!), added about 20 or 30 rotations and then subtracted ever decreasing amounts til it finished up where it started.

 

[Sal Paradise]

I have it pasted into a module and run it through the sheet using Alt-F8. If you'd like, you can feel free to add a command button or something and add the macro to it.

 

[bobinnc]

Jammoca,

I got Sal Paradise's code to work. It works very nicely.

I made a few tweaks:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulette()
    Dim i, j As Integer
    Dim intSlowDown As Integer
    Dim intStudents As Integer
    Dim intRotations As Integer
    Dim intStopsOn As Integer
    
    intStudents = Range("A1").End(xlDown).Row
    
    intRotations = Int((10 * Rnd) + 1)
    intStopsOn = Int((intStudents * Rnd) + 1)
        
    Range("A1:A" & intStudents).Interior.ColorIndex = xlNone
    For j = 1 To intRotations
        For i = 1 To intStudents
            intSlowDown = intSlowDown + 1
            Cells(i, 1).Interior.ColorIndex = 6
            If i = 1 Then
                Cells(intStudents, 1).Interior.ColorIndex = xlNone
            Else
                Cells(i - 1, 1).Interior.ColorIndex = xlNone
            End If
            
            If j = intRotations And i = intStopsOn Then
                MsgBox (Cells(i, 1).Value & " has been chosen")
                Exit Sub
            End If
            
            Sleep intSlowDown * 10
        Next i
    Next j
    
End Sub