excelvbatimerefreshcell

Refreshing Conditional Formatting in Sheet Every 20 Seconds


I have a sheet containing a daily schedule for class periods (school), and want to conditionally format columns in pairs every 20 seconds. For instance, first hour starts at 8:10 AM (in cell B3) and ends at 8:55 AM (C3). Second hour starts at 8:58 AM (D3) and runs until 9:40 (E3), etc. Using conditional formatting, I want to highlight the range B2:C3 in yellow while the actual NOW time is within the time span (B3, C3). Once the time is no more than 20 seconds beyond C3, I want to change the conditional formatting.

The problem is that the conditional formatting in the sheet won't update without me clicking on another sheet and then clicking back on the Schedule sheet. The conditional formatting works once I do this. I've spent hours researching this and am unable to figure this out. Any help would be SO greatly appreciated. Thanks so much.

Settings: In the VBA properties, EnableFormatConditionsCalculation is true. In Formulas > Calculation Options, Automatic is set.

Example conditional formatting for B2:C2 (these are merged): =IF(OR(AND(J1="N",TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW())) >= B3, TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW())) < C3),AND(J1="Y",TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW())) >= B4, TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW())) < C4),AND(L1="Y",TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW())) >= B5, TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW())) < C5)), TRUE, FALSE)

Example conditional formatting for B3: =AND(J1="N",TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW())) >= B3, TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW())) < C3)

Example conditional formatting for C3: =AND(J1="N",TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW())) >= B3, TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW())) < C3)

Background: There will basically be 3 different schedules within this sheet defined by

Code behind sheet12 named "Schedule":

Private Sub Worksheet_Activate()
    RecalculateWorkingHours
    With Application
        .EnableEvents = True
        .OnTime earliesttime:=Now + TimeValue("00:00:20"), procedure:="Refresh_Schedule", Schedule:=True
    End With
End Sub

Code behind ThisWorkbook:

Public Sub Workbook_Open()
    RecalculateWorkingHours
End Sub

Code in Module2:

Public Sub RecalculateWorkingHours()
    Dim T1 As Date
    Dim T2 As Date
    Dim x  As Variant
    T0 = Now
    T1 = TimeValue("8:00 AM")
    T2 = TimeValue("3:31 PM")
    If T0 >= T1 And T0 <= T2 Then
        Calculate
        Application.OnTime earliesttime:=Now + TimeValue("00:00:20"), procedure:="RecalculateWorkingHours" ', schedule:=False
    Else
    End If
End Sub

Public Sub Refresh_Schedule()
    Calculate
End Sub

Solution

  • Your code never run, because one of the two comparisons is always false. It includes the date also. Use the Time() function instead like this

      T0 = Time()