[help_CAT]

hey, can anyone help me with this?

I wanna change the colour of a specific cell continually and randomly without having to activate the macro. And i want to add in the element of time, so that the cells change colour automatically every, say, 2 secs.

Does anyone know the code for it?

[Gustav]

Originally Posted by help_CAT

... so that the cells change colour automatically every, say, 2 secs...

PHP Code:

 
Sub runItOneTimeManually()
    Range("A1").Value = 0
    Application.OnTime Now + TimeValue("00:00:02"), "autorunEveryTwoSeconds"
End Sub
 
Sub autorunEveryTwoSeconds()
    Range("A1").Value = Range("A1").Value + 2
    Range("A2").Interior.ColorIndex = Int(Rnd() * 10 + 30)
    Application.OnTime Now + TimeValue("00:00:02"), "autorunEveryTwoSeconds"
End Sub 


[help_CAT]

whao, thats great. thanks. =)

it works just the way i want it but i realise the macro doesnt stop. it goes on
forever.
What can i add to the code to stop the macro after it has generated a certain number of colours? For example, after the 10th random colour, the macro will stop. Do i have to use IF?

[Gustav]

Originally Posted by help_CAT

What can i add to the code to stop the macro after it has generated a certain number of colours?
...
Do i have to use IF?

Exactly!

PHP Code:

Sub runItOneTimeManually()
    Range("A1").Value = 0
    Range("B1").Value = 0
    Application.OnTime Now + TimeValue("00:00:02"), "autorunEveryTwoSeconds"
    Application.OnTime Now + TimeValue("00:00:03"), "autorunEveryThreeSeconds"
End Sub
 
Sub autorunEveryTwoSeconds()
    Range("A1").Value = Range("A1").Value + 2
    Range("A2").Interior.ColorIndex = Int(Rnd() * 10 + 30)
 
    If Range("A1").Value < 50 Then
        Application.OnTime Now + TimeValue("00:00:02"), "autorunEveryTwoSeconds"
    Else
        '"Do nothing here" = "Stop this process"
        ' because we do not set next time-point in future 
        '' that is "Now + 2 seconds later" :)
    End If 
End Sub
 
Sub autorunEveryThreeSeconds()
    Range("B1").Value = Range("B1").Value + 3
    Range("B2").Interior.ColorIndex = Int(Rnd() * 10 + 40)
 
    If Range("B1").Value < 75 Then
        Application.OnTime Now + TimeValue("00:00:03"), "autorunEveryThreeSeconds"
    Else
        '"Do nothing here" = "Stop this process",
        ' because we do not set next time-point in future, 
        '' that is "Now + 3 seconds later" :)
    End If
End Sub 


[Gustav]

1. Create new workbook.
2. Create new VBA-module .
3. Copy VBA-code below and then paste it into module.
4. Activate any worksheet in your new workbook.
5. Press Alt+F8 and run macro "setCountdownTimers".
6. Use Ctrl+F1 as stopper for "left player" (player 1) - this key will stop player1 clock and run player2 clock.
7. Use Ctrl+F12 as stopper for "right player" (player 2) - this key will stop player2 clock and run player1 clock.
8. Use any of these two combinations of keys for restarting the game after the previous game is over.
9. After final "game" press Alt+F8 and run macro "restoreKeys" to return Ctrl+F1 and Ctrl+F12 to theirs normal Excel meanings.

PHP Code:

Dim isFirstEntry1 As Boolean
Dim isFirstEntry2 As Boolean
 
Sub setCountdownTimers()
    Cells.Interior.ColorIndex = xlNone
 
    Range("A1").Value = "Player 1"
    Range("C1").Value = "Player 2"
 
    Range("A2").Value = 10
    Range("B2").Value = "<=>"
    Range("C2").Value = 10
 
    Range("B2").NumberFormat = "@"
    Range("A1:C2").HorizontalAlignment = xlCenter
 
    Application.OnKey "^{F1}", "keyPressedByPlayer1"
    Application.OnKey "^{F12}", "keyPressedByPlayer2"
End Sub
 
Sub keyPressedByPlayer2()
    If InStr(Range("B2").Value, "Loser") > 0 Then
        Call setCountdownTimers
        Exit Sub
    End If
 
    If Range("B2").Value <> "<=" Then
        Range("B2").Value = "<="
        Range("B2").HorizontalAlignment = xlLeft
        isFirstEntry1 = True
        Call runPlayer1
    End If
End Sub
 
Sub keyPressedByPlayer1()
    If InStr(Range("B2").Value, "Loser") > 0 Then
        Call setCountdownTimers
        Exit Sub
    End If
 
    If Range("B2").Value <> "=>" Then
        Range("B2").Value = "=>"
        Range("B2").HorizontalAlignment = xlRight
        isFirstEntry2 = True
        Call runPlayer2
    End If
End Sub
 
Sub runPlayer1()
    If Range("B2").Value = "<=" Then
        If Range("A2").Value > 0 Then
            Application.OnTime Now + TimeValue("00:00:01"), "runPlayer1"
            If Not isFirstEntry1 Then
                Range("A2").Value = Range("A2").Value - 1
            Else
                isFirstEntry1 = False
            End If
        Else
            Cells.Interior.ColorIndex = 6 'Yellow '
            Range("B2").Value = "<= Loser"
        End If
    End If
End Sub
 
Sub runPlayer2()
    If Range("B2").Value = "=>" Then
        If Range("C2").Value > 0 Then
            Application.OnTime Now + TimeValue("00:00:01"), "runPlayer2"
            If Not isFirstEntry2 Then
                Range("C2").Value = Range("C2").Value - 1
            Else
                isFirstEntry2 = False
            End If
        Else
            Cells.Interior.ColorIndex = 3 'Red '
            Range("B2").Value = "Loser =>"
        End If
    End If
End Sub
 
Sub restoreKeys()
    Application.OnKey "^{F1}"
    Application.OnKey "^{F12}"
End Sub