How to change the colour of a cell continually?

[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]

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

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]

how to stop? haha

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]

Two timers work simultaneously and will be switched off at different times

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!

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]

Little Bonus: Just Like Chess Clock...

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.

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