on ThisWorkbook paste:
Private Sub Workbook_Open()

Call changecolors

End Sub

then insert a module and paste:

Function SetCellColor(spot, Color)
Dim ColorN As Integer
If Color = "Lt Green" Then
ColorN = 15
ElseIf Color < 0.0399 Then
ColorN = 48
ElseIf (Color 0.04) And (Color < 0.0799) Then
ColorN = 34
ElseIf (Color 0.08) And (Color < 0.1199) Then
ColorN = 35
ElseIf (Color 0.12) And (Color < 0.1599) Then
ColorN = 39
ElseIf (Color 0.16) And (Color < 0.1999) Then
ColorN = 36
ElseIf (Color 0.2) And (Color < 0.2399) Then
ColorN = 33
ElseIf (Color 0.24) And (Color < 0.2799) Then
ColorN = 8
ElseIf (Color 0.28) And (Color < 0.3199) Then
ColorN = 4
ElseIf (Color 0.32) And (Color < 0.3599) Then
ColorN = 6
ElseIf (Color 0.36) And (Color < 0.3999) Then
ColorN = 44
ElseIf (Color 0.4) And (Color < 0.4499) Then
ColorN = 7
ElseIf (Color 0.45) And (Color < 0.5099) Then
ColorN = 54
ElseIf (Color 0.51) And (Color < 0.5599) Then
ColorN = 41
ElseIf (Color 0.56) And (Color < 0.6099) Then
ColorN = 42
ElseIf (Color 0.61) And (Color < 0.6499) Then
ColorN = 50
ElseIf (Color 0.65) And (Color < 0.6999) Then
ColorN = 3
ElseIf (Color 0.7) And (Color < 0.7399) Then
ColorN = 5
ElseIf (Color 0.74) And (Color < 0.7899) Then
ColorN = 10
ElseIf (Color 0.79) And (Color < 0.8299) Then
ColorN = 2
ElseIf (Color 0.83) And (Color < 0.8799) Then
ColorN = 38
ElseIf (Color 0.88) And (Color < 0.9299) Then
ColorN = 13
ElseIf (Color 0.93) And (Color < 0.9599) Then
ColorN = 45
ElseIf (Color 0.96) And (Color < 0.1) Then
ColorN = 1
Else
ColorN = 1
End If
Sheet1.Range("a1:q46").Font.ColorIndex = ColorN
End Function

insert another module and paste:

Public Sub Changecolors()

Dim Color As Single
Dim Bob As Single
Dim spot As Range
Dim counter As Single
For Bob = 1 To 100 Step 1
Randomize
Color = Rnd()
Set spot = Sheet1.Range("a1")
Call SetCellColor(spot, Color)
Application.Wait Now + TimeSerial(0, 0, 0.5)
Next Bob
ColorN = 1
Sheet1.Range("a1").Font.ColorIndex = ColorN
Range("a1").Select

End Sub


this will cause the word to change colors 100 times and always end o
black font

--
Message posted from http://www.ExcelForum.com