looping at regular interval

[grime]

I am trying to create a "marquee" effect by looping through 3 fill
effects.

It does what I'm going after, but only performs the fill effects once,
then stops. I am trying to get it to repeat from the beginning after
the 3rd fill effect.


Code:
--------------------
Dim iCount As Integer
Sub ColorChange()
Dim dTime As Date
dTime = Now
Application.OnTime dTime + TimeValue("00:00:01"), "ColorChange"
iCount = iCount + 1
If iCount = 1 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 13
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 8
End If
If iCount = 2 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 13
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 8
End If
If iCount = 3 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 13
End If
If iCount = 3 Then
iCount = 0
Application.OnTime dTime + TimeValue("00:00:01"), "ColorChange", , False
End If
End Sub

 

[Tom Ogilvy]

remove the line that cancels the Ontime (move it to another routine). Make
dtime a public variable or you won't be able to stop it without closing
Excel.

 

[grime]

I'm fairly new to the VBA thing. Can you explain that?

 

[Tom Ogilvy]

Dim iCount As Integer
Dim dTime as Date
Sub ColorChange()
dTime = Now
Application.OnTime dTime + TimeValue("00:00:01"), "ColorChange"
iCount = iCount + 1
If iCount = 1 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 13
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 8
End If
If iCount = 2 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 13
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 8
End If
If iCount = 3 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 13
End If
If iCount = 3 Then
iCount = 0
End If
End Sub

Sub StopAnimation()
Application.OnTime dTime + TimeValue("00:00:01"), "ColorChange", , False
End Sub