PDA

View Full Version : Automatically defining cell background color via system date

Datafiend81
06-02-2011, 08:59 PM
For each cell in which I enter data on a given day, I'd like the cell's background color to be automatically defined by my computer's system date.

When I go to:

Fill -> Background -> Color -> More Colors

I see an X-Y Color Palette. If I can set the Y coordinate as a function of month, and the x coordinate as a function of day, that would be perfect.

I'd like all cells' background colors to stay constant after data entry, regardless of system date.

Is there any way that I can do this in Excel?

Thank you

mikerickson
06-02-2011, 11:23 PM
You could put this in the sheet's code module
Private Sub Worksheet_Change(ByVal Target As Range)
Target.Interior.Color = RGBfromDate()
End Sub
and this in a normal module.
Function RGBfromDate()
RGBfromDate = RGBfromXY(Day(Date) / 31 - 0.5, Month(Date) / 12 - 0.5)
End Function

Function RGBfromXY(xVal As Double, yVal As Double) As Double
Dim Radius As Double, Angle As Double
Radius = (xVal ^ 2 + yVal ^ 2) ^ 0.5
If xVal <> 0 Then
Angle = Atn(yVal / xVal) / Application.Pi() * 180
If xVal < 0 Then Angle = Angle + 180
ElseIf yVal > 0 Then
Angle = 90
Else
Angle = 270
End If
If Angle < 0 Then Angle = Angle + 360
End Function

Function RGBfromRTheta(Radius As Double, theta As Double)
Dim baseR As Double, baseG As Double, baseB As Double
Dim antiR As Double, antiG As Double, antiB As Double
Dim temp As Double

temp = RGBfromDegree(theta, baseR, baseG, baseB)
temp = RGBfromDegree(180 + theta, antiR, antiG, antiB)

antiR = (1 - Radius) * antiR
antiG = (1 - Radius) * antiG
antiB = (1 - Radius) * antiB

RGBfromRTheta = RGB(255 * (baseR + antiR), 255 * (baseG + antiG), 255 * (baseB + antiB))
End Function

Function RGBfromDegree(Angle As Double, ByRef Rval As Double, ByRef Gval As Double, ByRef Bval As Double) As Double
Do Until Angle > 0
Angle = Angle + 360
Loop
Angle = Angle Mod 360
Select Case Angle
Case Is <= 60
Rval = 1
Gval = Angle / 60
Case Is <= 120
Gval = 1
Rval = (120 - Angle) / 60
Case Is < 180
Gval = 1
Bval = (Angle - 120) / 60
Case Is <= 240
Bval = 1
Gval = (240 - Angle) / 60
Case Is <= 300
Bval = 1
Rval = (Angle - 240) / 60
Case Else
Rval = 1
Bval = (360 - Angle) / 60
End Select
RGBfromDegree = RGB(255 * Rval, 255 * Gval, 255 * Bval)
End Function