Vba formatting of a1 cell

0

How do I use VBA to change the colour of a cell depending on value and time. I.e. see below.

Between 06.00am and 06.59am

0 to 10 colour is red

11 to 20 colour is amber

Above 20 is green

Between 07.00am and 07.59am

0 to 20 colour is red

21 to 100 is amber

Above 100 is green.

This wil carry on every hour of the day with different targets each hour

Answer
Discuss

Answers

0

Please install the code below in a standard code module (by default "Module1").

Option Explicit
Sub ResetCellColours()
    ' 28 Sep 2017
    SetCellColours ActiveSheet.Range("A1")
End Sub
Sub SetCellColours(Target As Range)
    ' 28 Sep 2017
    
    Dim Times(23) As Variant
    Dim FillCol As Variant, FontCol As Variant
    Dim Cat As Variant
    Dim V As Integer
    Dim i As Long
    
    FillCol = Array(vbRed, 49407, vbGreen)              ' red, amber, green
    FontCol = Array(16777215, 255, 0)                   ' white, red, black
    For i = 0 To UBound(Times)
        Times(i) = i / 24
    Next i
    Cat = Category(CLng(Application.Match((Now() - Date), Times, 1)))
    
    With Target
        V = Application.Match(.Value, Cat, 1) - 1
        .Interior.Color = FillCol(V)
        .Font.Color = FontCol(V)
    End With
End Sub
Private Function Category(T As Long) As Variant
    ' 28 Sep 2017
    Dim Fun(1 To 24) As Variant
    ' Fun(index) indicates the hour of the day:
    ' Fun(1) lasts from midnight to 01:59:59
    ' The Array defines the cell values which trigger colour changes:
    ' example Fun(1) 0-10 = colour 1 (Red),
    '               11-20 = colour 2 (Amber),
    '               21 and up = colour 3 (Green)
    
    Fun(1) = Array(0, 11, 21)
    Fun(2) = Array(0, 11, 21)
    Fun(3) = Array(0, 11, 21)
    Fun(4) = Array(0, 11, 21)
    Fun(5) = Array(0, 11, 21)
    Fun(6) = Array(0, 11, 21)
    Fun(7) = Array(0, 11, 21)
    Fun(8) = Array(0, 20, 100)
    Fun(9) = Array(0, 20, 100)
    Fun(10) = Array(0, 20, 100)
    Fun(11) = Array(0, 20, 100)
    Fun(12) = Array(0, 11, 21)
    Fun(13) = Array(0, 11, 21)
    Fun(14) = Array(0, 11, 21)
    Fun(15) = Array(0, 11, 21)
    Fun(16) = Array(0, 11, 21)
    Fun(17) = Array(0, 11, 21)
    Fun(18) = Array(0, 11, 21)
    Fun(19) = Array(0, 11, 21)
    Fun(20) = Array(0, 11, 21)
    Fun(21) = Array(0, 11, 21)
    Fun(22) = Array(0, 11, 21)
    Fun(23) = Array(0, 11, 21)
    Fun(24) = Array(0, 11, 21)
    
    Category = Fun(T)
End Function

You can run the code by placing ther cursor within the procedure "ResetCellColours" and press F5, or call that sub by any other means. Within "ResetCellColours" you can change the target of the code's action. It is set to "A1" as per your request.

The function "Category" allows you to set up different trigger values for each hour of the day. I wrote instructions within the procedure itself.

You can modify the Fill and Font colours in the procedure "SetCellColours". Bear in mind that vbRed (255) and vbGreen (65280) are numbers and may be replaced with other numbers indicating shades perhaps more to your liking.

No arrangement has been made to run the code. However, you may like to install this little procedure in the code sheet of the worksheet on which your "A1" is located.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 28 Sep 2017
    If Target.Address = Range("A1").Address Then SetCellColours Target
End Sub

If you install this procedure the code will run whenever A1 is changed. I used it for testing. If you plan on having a timer update the colours every hour, the timer's procedure must call "ResetCellColours".

Discuss

Answer the Question

You must create an account to use the forum. Create an Account or Login