[2 days left] Whatâ€™s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now

x
Solved

# Convert Conditional Formula

Posted on 2011-02-13
Medium Priority
436 Views
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
Question by:Cartillo
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 7
• 5
• 4

LVL 30

Expert Comment

ID: 34883449
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

"=AND(\$H7=TODAY(), \$I7+TODAY()<=NOW()-TIME(0,5,0),\$I7>0)"
.FormatConditions(1).Interior.ColorIndex = 3

"=AND(NOW()>=\$H7+\$I7,NOW()<=\$H7+\$J7)"
.FormatConditions(2).Interior.ColorIndex = 50

"=AND(\$H7=TODAY(),\$I7+TODAY()=NOW()+TIME(0,5,0),\$I7+TODAY()>NOW())"
.FormatConditions(3).Interior.ColorIndex = 6
End With
End Sub
``````

Sid
0

LVL 18

Expert Comment

ID: 34884035
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

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
``````
ConditionData.xls
0

LVL 18

Expert Comment

ID: 34884077
Oops,

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

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

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
``````
ConditionData.xls
0

LVL 18

Expert Comment

ID: 34884412
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

ID: 34885719
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

ID: 34886994
Cartillo: Did you try the code that I posted?

Sid
0

LVL 18

Expert Comment

ID: 34893059
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

ID: 34904144
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

LVL 18

Expert Comment

ID: 34904266
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

ID: 34905363
Quick question. Which column are you applying the formatting in?

Sid
0

Author Comment

ID: 34905375
Hi Sid,

I'm using column 9.
0

LVL 30

Accepted Solution

SiddharthRout earned 1000 total points
ID: 34905384
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
"=AND(\$H7=TODAY(), \$I7+TODAY()<=NOW()-TIME(0,5,0),\$I7>0)"
.FormatConditions(1).Interior.ColorIndex = 3

.Range("I2").Select
"=AND(NOW()>=\$H7+\$I7,NOW()<=\$H7+\$J7)"
.FormatConditions(2).Interior.ColorIndex = 50

.Range("I2").Select
"=AND(\$H7=TODAY(),\$I7+TODAY()=NOW()+TIME(0,5,0),\$I7+TODAY()>NOW())"
.FormatConditions(3).Interior.ColorIndex = 6
End With
End Sub
``````

Sid
0

LVL 18

Expert Comment

ID: 34906522
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

ID: 34906569
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

Cory Vandenberg earned 1000 total points
ID: 34907555
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

ID: 35023501
Hi,

Thanks for the help
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are â€¦
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will diâ€¦
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custoâ€¦
###### Suggested Courses
Course of the Month14 days, 12 hours left to enroll