Link to home
Start Free TrialLog in
Avatar of Cartillo
CartilloFlag for Malaysia

asked on

Convert Conditional Formula

Hi Experts,

I would like to request Experts help to convert the listed condition format formula into script/macro. The reason is the condition format has been deleted for some reason after a while and I need to manually recopy the whole formula back into the sheet. Hope by converting this formula into a script the current problem can be prevented.  I attached the workbook as well for Experts perusal.

Red color condition: =AND($H7=TODAY(), $I7+TODAY()<=NOW()-TIME(0,5,0),$I7>0)
Green color condition: =AND(NOW()>=$H7+$I7,NOW()<=$H7+$J7)
Yellow color condition: =AND($H7=TODAY(),$I7+TODAY()=NOW()+TIME(0,5,0),$I7+TODAY()>NOW())

ConditionData.xls
Avatar of SiddharthRout
SiddharthRout
Flag of India image

Try this

Sub Sample()
    '~~> Change Sheet1 with the relevant sheet name
    '~~> Change Column 9 to relevant column Number
    '~~> Where you want to apply the formatting
    With Sheets("Sheet1").Columns(9)
        .FormatConditions.Delete
        
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND($H7=TODAY(), $I7+TODAY()<=NOW()-TIME(0,5,0),$I7>0)"
        .FormatConditions(1).Interior.ColorIndex = 3
        
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND(NOW()>=$H7+$I7,NOW()<=$H7+$J7)"
        .FormatConditions(2).Interior.ColorIndex = 50
        
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND($H7=TODAY(),$I7+TODAY()=NOW()+TIME(0,5,0),$I7+TODAY()>NOW())"
        .FormatConditions(3).Interior.ColorIndex = 6
    End With
End Sub

Open in new window


Sid
Avatar of Cory Vandenberg
Cartillo,

If you are going to code this via a macro, there is no need to use conditional formatting properties as in Sid's solution, although it is a valid solution.  I believe you said there was a problem with these "disappearing".  I'm not sure how, but my guess would be that a user is removing the conditional formatting.  If you program this with a Worsheet_Change event and some conditional code to handle the highlighting, it would make it harder to remove for the average Excel user.  Also, the sheet would not recalculate all the conditional formatting formulas every time the sheet is changed.  On a large sheet, this could affect performance.

I have attached a workbook to illustrate this.  Go to the VB Editor (Alt+F11) and view the code for the Datasheet worksheet.  I abstracted the code, which should make it easy to adjust the function calls in case your layout changes, or you want to add additional functionality for Record 2 Time In/Time Out.

WC
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sRow As Long
    
    sRow = 7            'You can change this to edit where the Change event will take effect
    If Not Intersect(Target, Rows(sRow & ":" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        Call CheckRow(Range("H" & Target.Row), Range("I" & Target.Row), Range("J" & Target.Row), Target.Row)
    End If
End Sub

Private Sub CheckRow(recordDate As String, timeIn As String, timeOut As String, r As Long)
    If Range("H" & r) <> "" And Range("I" & r) <> "" Then
        If Now + TimeValue("00:05") < Range("H" & r) + Range("I" & r) Then
            Range("A" & r & ":N" & r).Interior.Color = xlNone
        ElseIf Range("J" & r) <> "" Then
            If Now() >= Range("H" & r) + Range("J" & r) Then
                Range("A" & r & ":N" & r).Interior.Color = RGB(255, 0, 0)
            ElseIf Now() >= Range("H" & r) + Range("I" & r) Then
                Range("A" & r & ":N" & r).Interior.Color = RGB(0, 255, 0)
            Else
                Range("A" & r & ":N" & r).Interior.Color = RGB(255, 255, 0)
            End If
        End If
    End If
End Sub

Public Sub UpdateSheet()
    Dim r As Long
    
    Application.ScreenUpdating = False
    For r = 7 To Range("A" & Rows.Count).End(xlUp).Row
        Call CheckRow(Range("H" & r), Range("I" & r), Range("J" & r), r)
    Next r
    Application.ScreenUpdating = True
End Sub

Open in new window

ConditionData.xls
Oops,

I forgot to update some of the code.  Here is the correct abstracted version.

Sorry about that.

WC
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sRow As Long
    
    sRow = 7            'You can change this to edit where the Change event will take effect
    If Not Intersect(Target, Rows(sRow & ":" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        Call CheckRow(Range("H" & Target.Row), Range("I" & Target.Row), Range("J" & Target.Row), Target.Row)
    End If
End Sub

Private Sub CheckRow(recordDate As Long, timeIn As Double, timeOut As Double, r As Long)
    If recordDate <> 0 And timeIn <> 0 Then
        If Now + TimeValue("00:05") < recordDate + timeIn Then
            Range("A" & r & ":N" & r).Interior.Color = xlNone
        ElseIf timeOut <> 0 Then
            If Now() >= recordDate + timeOut Then
                Range("A" & r & ":N" & r).Interior.Color = RGB(255, 0, 0)
            ElseIf Now() >= recordDate + timeIn Then
                Range("A" & r & ":N" & r).Interior.Color = RGB(0, 255, 0)
            Else
                Range("A" & r & ":N" & r).Interior.Color = RGB(255, 255, 0)
            End If
        End If
    End If
End Sub

Public Sub UpdateSheet()
    Dim r As Long
    
    Application.ScreenUpdating = False
    For r = 7 To Range("A" & Rows.Count).End(xlUp).Row
        Call CheckRow(Range("H" & r), Range("I" & r), Range("J" & r), r)
    Next r
    Application.ScreenUpdating = True
End Sub

Open in new window

ConditionData.xls
I just realized my Change event will trigger when any cell from Row 7 to your last row is changed.  you can edit that Intersect to just include the columns of importance, such as the Record Date, Time On, and Time Off.  Just change that line to the following:

If Not Intersect(Target, Rows(sRow & ":" & Range("A" & Rows.Count).End(xlUp).Row), Columns("H:J")) Is Nothing Then

You can add add more ranges to the Intersect if you need to.

WC
Avatar of Cartillo

ASKER

Hi WC,

Thanks for the script. Have tested, the red and green formula works well but the yellow color wasn’t change into green after its exceed the condition time. Hope you can help me to fix this.
Cartillo: Did you try the code that I posted?

Sid
Cartillo,

The sheet won't update automatically as time goes by.  You either need to hit the 'Update Sheet' button I placed at the top of the sheet, or insert a timer into the macro to run the script every n minutes.

The conditional formatting won't update on it's own either, but it will recalculate anytime the sheet is recalculated.

The code works fine for me.  It is yellow within 5 minutes of Time In, and when I hit Update Sheet after the Time In has passed, before the Time Out is passed, it changes to green.

WC
Hi WC,

Thanks for the detail explanation. Is that way to set the color change automatically as and when the is passed without hitting the change button? Hope this is possible.

Hi Sid,

I have tested the code, its not really giving the right result.
Cartillo,

As I stated before, the only way to have this update as time passes is to put a Timer in the code and have it execute the same macro the button does at your desired interval.  Obviously, the shorter the interval, the more process intensive this will be.

I've never really worked with programs that need to update that way.  I'm sure there are experts here and resources online that could help you better than I could.

Check out one of my favorite resources for some more info.  Chip Pearson's site OnTime Method

Hope that gets you in the right direction.

WC
Quick question. Which column are you applying the formatting in?

Sid
Hi Sid,

I'm using column 9.
ASKER CERTIFIED SOLUTION
Avatar of SiddharthRout
SiddharthRout
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Just want to point out one more time, that even with Sid's solution, you will need some user interaction.  The formatting won't change unless the worksheet changes somehow and forces a recalculate.  The only way to have the formatting change automatically is via the OnTime method as far as I know.

WC
You have a point WC but if I keep it in the Workbook open event then the user intervention is also gone.

Sid
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Hi,

Thanks for the help