Solved

Convert Conditional Formula

Posted on 2011-02-13
16
428 Views
Last Modified: 2012-05-11
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
0
Comment
Question by:Cartillo
  • 7
  • 5
  • 4
16 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
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
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
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
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
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
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
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
0
 

Author Comment

by:Cartillo
Comment Utility
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.
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Cartillo: Did you try the code that I posted?

Sid
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
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
0
 

Author Comment

by:Cartillo
Comment Utility
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.
0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
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
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Quick question. Which column are you applying the formatting in?

Sid
0
 

Author Comment

by:Cartillo
Comment Utility
Hi Sid,

I'm using column 9.
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 250 total points
Comment Utility
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
        
        .Range("I2").Select
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND($H7=TODAY(), $I7+TODAY()<=NOW()-TIME(0,5,0),$I7>0)"
        .FormatConditions(1).Interior.ColorIndex = 3
        
        .Range("I2").Select
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND(NOW()>=$H7+$I7,NOW()<=$H7+$J7)"
        .FormatConditions(2).Interior.ColorIndex = 50
        
        .Range("I2").Select
        .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
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
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
0
 
LVL 30

Expert Comment

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

Sid
0
 
LVL 18

Assisted Solution

by:WarCrimes
WarCrimes earned 250 total points
Comment Utility
That is true when the workbook is opened, yes.  What if the user needs the formatting to update while the workbook is open?  If they only need the update at the time of opening the workbook, then using the button I supplied is just as easy as placing the code in the Open event.

WC
0
 

Author Closing Comment

by:Cartillo
Comment Utility
Hi,

Thanks for the help
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now