Conditional Formatting between dates

jeckjeck_13 · Jul 7, 2008

Hi to all,

I want to ask for help to set up an excel sheet with a formula. The scenario is like this:

We need to track the batteries if it is expired or not.Expiration is 3 months. once you received the battery, you need to put the date in the sheet (A1) and then the expiration will be automatically calculated in B1. another also, in B1, will change its color according to how may days left before the expiration date.

black color if the expiration is < 15 days
red color if the expiration is <30 days
yellow color if the expiration is between 31 and 44 days
green color if the expiration is > 45 days
white color if B1 is blank

If the expiration is <30 days, there should be an alert. it either a message will pop up or anything that will make a very good alarm.

Please help me to make this sheet.

Regards,
ernest

Peter_SSs · Jul 7, 2008

jeckjeck_13

Welcome to the MrExcel board!

The normal method to do such colouring is to use Conditional Formatting. However, until Excel 2007, there has been a limit of three conditions in Conditional formatting.

Therefore, if you have Excel 2007 you can use Conditional Formatting but if you are using an earlier version, you would need to use some vba to achieve this result. An alternative would be to reduce the number of colours required to 4 (1 standard and 3 applied by Conditional Formatting).

So if you need further help, please advise your Excel version.

Also, can you confirm that this would be happening with a list of dates down column A?

jeckjeck_13 · Jul 8, 2008

Sir Peter,

Thanks for the reply. I have both excel 2002 and 2007. I prefer to use 2002 because most of the excel versions in our location is version 2002. Sir, there will be a lists of dates because you need to put a lot of batteries so you will see a lot of batteries listed in the sheet(Column A). Sir, please help me make the automated sheet so I can solve my problem.

Regards,
Ernest

Peter_SSs · Jul 8, 2008

Ernest

There are a number of things that are not exactly clear about your requirement, but I think this should point you in the right direction. You should be able to modify this to suit just what you want. However, post back if you are still having difficulty.

1. Formulas in row 2 are copied down as far as needed.
2. Select column D by clicking its heading label and apply the conditional formatting shown for cell D1.
3. Right click the sheet name tab and choose "View Code"
4. Copy and paste the code below into the main right hand pane that opens at step 3.
5. Close the Visual Basic window.
6. Make/change some entries in column A.

Excel Workbook

A

B

C

D

E

F

G

1

Received Date

Expiry Date

Days Till Expiry

Warning

Toady:

08/07/2008

2

16/04/2008

15/07/2008

7

ALERT

3

26/05/2008

24/08/2008

47

4

10/04/2008

09/07/2008

1

ALERT

5

05/06/2008

03/09/2008

57

6

06/03/2008

04/06/2008

Expired

7

16/05/2008

14/08/2008

37

8

06/05/2008

04/08/2008

27

ALERT

Expiry Dates

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
D1	1. / Cell Value equal to ="ALERT"	Abc
D2	1. / Cell Value equal to ="ALERT"	Abc

Private Sub Worksheet_Calculate() Dim ExpiryDays As Range Dim c As Range Dim iColor As Long Application.ScreenUpdating = False Set ExpiryDays = Range("C2", Range("C" & Rows.Count).End(xlUp)) For Each c In ExpiryDays Select Case c.Value Case "Expired", "" iColor = xlNone Case Is > 45 iColor = 4 Case Is > 30 iColor = 6 Case Is > 15 iColor = 3 Case Is > 0 iColor = 48 Case Else iColor = xlNone End Select c.Interior.ColorIndex = iColor Next c Application.ScreenUpdating = True End Sub

jeckjeck_13 · Jul 8, 2008

Hi Sir Peter,

Thanks for this... I have manage to follow your instructions and it works fine. I just want to ask if we can also highlight the "Expiration (column D)" same as Column C. And also can we add a pop up message that reminds the user how many good, near to expire or expired batteries he has?

Regards,
Ernest

Peter_SSs · Jul 8, 2008

jeckjeck_13 said:
... can also highlight the "Expiration (column D)" same as Column C.

1. remove the Conditional Formatting from column D
2. Change the 4th last line of code to

Code:

c.Resize(, 2).Interior.ColorIndex = iColor

And also can we add a pop up message that reminds the user how many good, near to expire or expired batteries he has?

What, exactly, does "... good, near to expire or expired ..." mean? Does it mean the number of entries that have "Alert" in column D?

If I added the pop-up to the current code it would pop up very often and the user might get very sick of it. So... how often would you want this message to pop up? Maybe just when the sheet is opened? Or just when an entry is added/deleted/changed in column A?

jeckjeck_13 · Jul 8, 2008

Sorry Sir if I didnt make it clear... It's better to pop-up everytime you open and close the sheet.

If the expiry date is <30 days, the color of its cell will be red

If the expiry date is between 30 and 45 days, the color of its cell will be yellow

If the expiry date is >45 days, the color of its cell will be green

What you have done is you made a column which counts the number of days left before the expiration date and by that the color is changing. Right? What I want is to eliminate this and highlight the cell which the expiry date are listed. so there will be only 2 columns... column 1 is the installation date and column number 2 is the expiry date....

Thanks a lot,

Ernest

Peter_SSs · Jul 8, 2008

Some more clarification then:

1. Is there only one sheet in the workbook? If not, what is the name of this worksheet containing the dates?

If the expiry date is <30 days, the color of its cell will be red

2. Does the above mean you have dropped the condition of black if < 15 days?

3. Can you confirm that you also don't want column D like I had, and instead you just want a pop-up message when opening and closing the sheet?

4. You didn't answer my other question:

What, exactly, does "... good, near to expire or expired ..." mean?

If I don't have this clarified, I don't know what to put in the pop-up message.

jeckjeck_13 · Jul 8, 2008

Sir,

Answers:

1) lets make 2 sheets. Sheet 1 will be for battery A and sheet 2 will be for battery B

2)<15 days = black is working fine.... no issues.. can we make it more black with white font?

3&4) pop-up message will just let us know what is the status of batteries:

Good means >45 days before expiration
Near means between 30 and 45 days before expiration
Need to replace means < 30 days before the expiration
Bad means < 15 days before the expiration.

When you open the workbook, the pop-up message will appear saying that you have: 10 good, 4 near, 3 need to replace and 1 bad batteries.

Summary:
A1 columns contains the installation dates
B1 columns contains the expiry dates

Cells in "B" column will be highlighted depending ion the conditions mentioned above.

Pop-up message will give us the summary of what is the status of the batteries. (When you open and when you close the workbook.

Sir, I hope I made it clear this time... I have added some so that it will make the sheet more hi-tech and useful.

Thanks,
Ernest

Peter_SSs · Jul 9, 2008

Give this a try. Make sure you have a backup of your file first.

1. For each sheet you want to colour and check, paste this code in the VB window for that sheet.

Private Sub Worksheet_Change(ByVal Target As Range) CheckExpiry Target, False, Me.Name End Sub

2. While still in the VB window, double click the "ThisWorkBook" section and paste this code.

Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim ws As Worksheet For Each ws In Worksheets CheckExpiry ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp)), True, ws.Name Next ws End Sub Private Sub Workbook_Open() Dim ws As Worksheet For Each ws In Worksheets CheckExpiry ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp)), True, ws.Name Next ws End Sub

3. While still in the VB window, use the menu to Insert|Module and paste this code.

Public Sub CheckExpiry(ByRef myTarget As Range, ByVal OpenClose As Boolean, ByVal wsName As String) Dim Tday As Date Dim chRng As Range Dim c As Range Dim iColor As Long Dim fColor As Long Dim Report(2, 4) As String Dim ReportString As String Dim i As Integer Set chRng = Intersect(myTarget, myTarget.Parent.Columns("A")) If Not chRng Is Nothing Then Application.ScreenUpdating = False Tday = Date For i = 1 To 4 Report(2, i) = 0 Next i For Each c In chRng.Offset(, 1) fColor = xlAutomatic Select Case c.Value - Tday Case Is <= 0, "" iColor = xlNone Case Is < 15 iColor = 1 fColor = 2 Report(2, 4) = Val(Report(2, 4)) + 1 Case Is < 30 iColor = 3 Report(2, 3) = Val(Report(2, 3)) + 1 Case Is <= 45 iColor = 6 Report(2, 2) = Val(Report(2, 2)) + 1 Case Is > 45 iColor = 4 Report(2, 1) = Val(Report(2, 1)) + 1 Case Else iColor = xlNone End Select c.Interior.ColorIndex = iColor c.Font.ColorIndex = fColor Next c If OpenClose Then Report(1, 1) = "Good = ": Report(1, 2) = "Near = " Report(1, 3) = "Need to Replace = ": Report(1, 4) = "Bad = " ReportString = "For Sheet " & wsName & vbLf & vbLf For i = 1 To 4 ReportString = ReportString & Report(1, i) & Report(2, i) & vbLf Next i Application.ScreenUpdating = True MsgBox ReportString End If Application.ScreenUpdating = True End If End Sub

4. Close the VB window, save the Workbook and try changing values in column A (you still need the formulas in column B), closing the Workbook, re-opening the Workbook.

Conditional Formatting between dates

jeckjeck_13

New Member

Excel Facts

Peter_SSs

MrExcel MVP, Moderator

jeckjeck_13

New Member

Peter_SSs

MrExcel MVP, Moderator

jeckjeck_13

New Member

Peter_SSs

MrExcel MVP, Moderator

jeckjeck_13

New Member

Peter_SSs

MrExcel MVP, Moderator

jeckjeck_13

New Member

Peter_SSs

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Conditional Formatting between dates

New Member

Excel Facts

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock