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 Radius > 1 Then Radius = 1
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
RGBfromXY = RGBfromRTheta(Radius, Angle)
End Function

Function RGBfromRTheta(Radius As Double, theta As Double)
Rem 0<=radius<=1, 0<=theta<=360
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