Conditional Formatting of Dates (Multiple Criteria)

[msiyab]

Hi,

I have an Cheque Book Register in Excel.
Column A = Cheque Date
Column N = Clearing Date

I want the Conditional Formatting to highlight Column A if the below criterias are met.
1. Column N is blank.
2. If current date is 150+ days than the Column A date.

I need this to know if a cheque is nearing its expiry date (6 months).

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.eileenslounge.com/viewtopic.php?p=312533#p312533 (https://www.eileenslounge.com/viewtopic.php?p=312533#p312533)
https://www.eileenslounge.com/viewtopic.php?f=44&t=40373&p=312499#p312499 (https://www.eileenslounge.com/viewtopic.php?f=44&t=40373&p=312499#p312499)
https://www.eileenslounge.com/viewtopic.php?p=311844#p311844 (https://www.eileenslounge.com/viewtopic.php?p=311844#p311844)
https://archive.org/download/wlsetup-all_201802/wlsetup-all.exe (https://archive.org/download/wlsetup-all_201802/wlsetup-all.exe)
https://www.eileenslounge.com/viewtopic.php?p=311826#p311826 (https://www.eileenslounge.com/viewtopic.php?p=311826#p311826)
https://www.eileenslounge.com/viewtopic.php?f=37&t=40261&p=311783#p311783 (https://www.eileenslounge.com/viewtopic.php?f=37&t=40261&p=311783#p311783)
https://www.eileenslounge.com/viewtopic.php?p=310916#p310916 (https://www.eileenslounge.com/viewtopic.php?p=310916#p310916)
https://www.eileenslounge.com/viewtopic.php?p=310720#p310720 (https://www.eileenslounge.com/viewtopic.php?p=310720#p310720)
https://www.eileenslounge.com/viewtopic.php?f=56&t=40034&p=310171#p310171 (https://www.eileenslounge.com/viewtopic.php?f=56&t=40034&p=310171#p310171)
https://www.eileenslounge.com/viewtopic.php?p=310110#p310110 (https://www.eileenslounge.com/viewtopic.php?p=310110#p310110)
https://www.eileenslounge.com/viewtopic.php?p=310024#p310024 (https://www.eileenslounge.com/viewtopic.php?p=310024#p310024)
https://www.eileenslounge.com/viewtopic.php?p=309121#p309121 (https://www.eileenslounge.com/viewtopic.php?p=309121#p309121)
https://www.eileenslounge.com/viewtopic.php?p=309101#p309101 (https://www.eileenslounge.com/viewtopic.php?p=309101#p309101)
https://www.eileenslounge.com/viewtopic.php?p=308945#p308945 (https://www.eileenslounge.com/viewtopic.php?p=308945#p308945)
https://www.eileenslounge.com/viewtopic.php?f=30&t=39858&p=308880#p308880 (https://www.eileenslounge.com/viewtopic.php?f=30&t=39858&p=308880#p308880)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[DocAElstein]

Hello msiyab,
I do not know how to do this with a formula. I think it is possible to do with a formula, but I do not know how to do it.

Here is VBA way, for

Column A = Cheque Date
Column N = Clearing Date
I want the Conditional Formatting to highlight Column A if the below criterias are met.
1. Column N is blank. 2. If current date is 150+ days than the Column A date.
I need this to know if a cheque is nearing its expiry date (6 months).
If column N = "" And Today - Column A => 150 Then interior color is yellow

Alan

_.______________________

Before:
_____ Workbook: CheckCheque.xlsm ( Using Excel 2007 32 bit )
Row\Col
A
B
C
D
E
F
G
H
I
J
K
L
M
N
O

1
12.09.2018


2
13.09.2018
07.02.2019


3
12.09.2018
07.02.2019


4
11.09.2018
07.02.2019


5
10.09.2018


6
09.09.2018
07.02.2019


7
Worksheet: Tabelle1
_____ Workbook: CheckCheque.xlsm ( Using Excel 2007 32 bit )
Row\Col
A
B
C
D
E
F
G
H
I
J
K
L
M
N
O

1
=TODAY()-148


2
=TODAY()-147
=TODAY()


3
=TODAY()-148
=TODAY()


4
=TODAY()-149
=TODAY()


5
=TODAY()-150


6
=TODAY()-151
=TODAY()


7
Worksheet: Tabelle1

Run routine:
Option Explicit
Sub ChkChqe() ' http://www.excelfox.com/forum/showthread.php/2301-Conditional-Formatting-of-Dates-(Multiple-Criteria)
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' First tab countiung from the left
Dim rngA As Range: Set rngA = Ws1.Range("A1:A" & Ws1.UsedRange.Rows.Count & "")
Dim rngN As Range: Set rngN = Ws1.Range("N1:N" & Ws1.UsedRange.Rows.Count & "")
Dim arrA() As Variant, arrN() As Variant
Let arrA() = rngA.Value2: Let arrN() = rngN.Value2
Dim Nah As Long: Let Nah = Now
Dim Cnt As Long
For Cnt = 1 To Ws1.UsedRange.Rows.Count
If arrN(Cnt, 1) = "" And (Nah - arrA(Cnt, 1)) >= 150 Then rngA.Item(Cnt).Interior.Color = vbYellow
Next Cnt
End Sub


' msiyab
' Conditional Formatting of Dates (Multiple Criteria)
' Hi,
'
' I have an Cheque Book Register in Excel.
' Column A = Cheque Date
' Column N = Clearing Date
'
' I want the Conditional Formatting to highlight Column A if the below criterias are met.
' 1. Column N is blank.
' 2. If current date is 150+ days than the Column A date.
'
' I need this to know if a cheque is nearing its expiry date (6 months).


After:
_____ Workbook: CheckCheque.xlsm ( Using Excel 2007 32 bit )
Row\Col
A
B
C
D
E
F
G
H
I
J
K
L
M
N
O

1
12.09.2018


2
13.09.2018
07.02.2019


3
12.09.2018
07.02.2019


4
11.09.2018
07.02.2019


5
10.09.2018


6
09.09.2018
07.02.2019


7
Worksheet: Tabelle1

[msiyab]

Hi,

Just checked the VBA, and I'm getting an error for this line:

If arrN(Cnt, 1) = "" And (Nah - arrA(Cnt, 1)) >= 150 Then

What might be the reason?

[DocAElstein]

Hi
_1 What is the error?
_2 can you upload a small amount of test data where you have the error , ( Change any personal or senstive data )
Alan

[msiyab]

Hi
_1 What is the error?

Run-time error '13':
Type mismatch


_2 can you upload a small amount of test data where you have the error , ( Change any personal or senstive data )
Alan
Sorry its a company worksheet, with multiple formula, links, etc.

[DocAElstein]

Hi
I expected that it might be that type of error. Such an error is typical when tying to compare dates.
I cannot help further without some test data.
I only need column A and column N.
Can you upload a small sample with just column A and column N. You can delete all other information. I only need to see the two columns of dates.

[msiyab]

2156

I have attached a sample workbook

Please note, I have added a few more columns. So the previous Column N is now Column L in the new file.

[DocAElstein]

Hi msiyab
Thanks for sample workbook

To find Where is problem:
We can look at variables…
But first

[msiyab]

2162

Still does not seem to work. The highlight remains no matter which date i put.

Am i doing something wrong here?

[DocAElstein]

Explain again very carefully what you want.
Give examples to show all scenarios
What is the current problem ?

[msiyab]

Sorry for the trouble.

I have attached the excel with a few lines of data to test the VBA.

If you check Row # 76, The Cheque date is 01-01-2019, and the Clearing Date too is 01-01-2019. Yet the Cheque date in Column A is highlighted. This should not happen.

If you check Row # 78, The Cheque date is 10-09-2018, and the Clearing Date is 15-09-2018. Yet the Cheque date in Column A is highlighted. This should not happen. As the data in Column L indicates that the cheque has been cleared on 15-09-2018

Now, if you check Row # 79, The Cheque date is 10-09-2018 (which is 150+ days old), but column L is empty as the cheque has not cleared. This is the only time that the data in Cell A79 should be highlighted.

Also, all the blank cells from Row # 80 and below are highlighted even though there is no data present.


I hope my explanation was clear.

2163

[DocAElstein]

Hi …
Blank row problem ….
This problem is because

_ I use all UsedRange … This includes
empty column A and empty column L
If column L = “”
If arrL(Cnt, 1) = “” __ is True

If column A = “”
If ____ (Nah - arrA(Cnt, 1)) >= 150 __ is True

So
If arrL(Cnt, 1) = "" And (Nah - arrA(Cnt, 1)) >= 150
is __ = True __ and __ True
So Then Interior Color is made to be vbYellow
This is the problem. You do not want that…

How about,
If column A is “” then Do Nothing

Option Explicit
Sub ChkChqe()
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1)
Dim rngA As Range: Set rngA = Ws1.Range("A1:A" & Ws1.UsedRange.Rows.Count & "")
Dim rngL As Range: Set rngL = Ws1.Range("L1:L" & Ws1.UsedRange.Rows.Count & "")
Dim arrA() As Variant, arrL() As Variant
Let arrA() = rngA.Value2: Let arrL() = rngL.Value2
Dim Nah As Long: Let Nah = Now
Dim Cnt As Long
For Cnt = 3 To Ws1.UsedRange.Rows.Count
If arrA(Cnt, 1) = "" Then
' Do nothing
Else
If arrL(Cnt, 1) = "" And (Nah - arrA(Cnt, 1)) >= 150 Then rngA.Item(Cnt).Interior.Color = vbYellow
End If
Next Cnt
End Sub

Now I think all is OK

Before:
_____ Workbook: Cheque Book Register 11Feb.xls ( Using Excel 2007 32 bit )
Row\Col
A
B
C
D
E
F
G
H
I
J
K
L
M

74
10.02.2019
072499
19,500.00






Not Entered


75
10.02.2019
072500






Not Entered


76
01.01.2019
072501
2,000.00
01.01.2019



Cleared
01.01.2019
Not Entered


77
10.02.2019
072502
2,000.00
10.02.2019



Cleared
10.02.2019
Not Entered


78
10.09.2018

2,000.00
10.09.2018



Cleared
15.09.2018
Not Entered


79
10.09.2018

2,000.00
31.12.2018





Not Entered


80








Not Entered
Worksheet: Cheques

After running routine, Sub ChkChqe()
_____ Workbook: Cheque Book Register 11Feb.xls ( Using Excel 2007 32 bit )
Row\Col
A
B
C
D
E
F
G
H
I
J
K
L
M

75
10.02.2019
072500






Not Entered


76
01.01.2019
072501
2,000.00
01.01.2019



Cleared
01.01.2019
Not Entered


77
10.02.2019
072502
2,000.00
10.02.2019



Cleared
10.02.2019
Not Entered


78
10.09.2018

2,000.00
10.09.2018



Cleared
15.09.2018
Not Entered


79
10.09.2018

2,000.00
31.12.2018





Not Entered


80








Not Entered
Worksheet: Cheques

Alan

[msiyab]

2165

The highlighting of cells when Column A is blank has gone. It is even highlighting if the date in Column A is 150 days or older.


However, If you check Rows 79 & 81 in the attached excel above, Column A is still highlighted even though I have entered the clearing date in Column L.

Can you create a condition that if there is any date in Column L, Column A should not be highlighted irrespective of the date being 150+ days old in Column A.

[DocAElstein]

Hello msiyab,
Possibly Solution 1: This could be to refresh the range of dates in column A so that initially all the yellow highlighting is cleared.
( We do not want to risk changing anything you have in cells A1 and A2, so we can use the Offset( , ) property on the range followed by the Resize( , ) Property to adjust the range dimensions. )

Sub ChkChqe()
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1)
Dim rngA As Range: Set rngA = Ws1.Range("A1:A" & Ws1.UsedRange.Rows.Count & "")
Let rngA.Offset(2, 0).Resize(Ws1.UsedRange.Rows.Count - 2, 1).Interior.TintAndShade = 0
Dim rngL As Range: Set rngL = Ws1.Range("L1:L" & Ws1.UsedRange.Rows.Count & "")
Dim arrA() As Variant, arrL() As Variant
Let arrA() = rngA.Value2: Let arrL() = rngL.Value2
Dim Nah As Long: Let Nah = Now
Dim Cnt As Long
For Cnt = 3 To Ws1.UsedRange.Rows.Count
If arrA(Cnt, 1) = "" Then
' Do nothing
Else
If arrL(Cnt, 1) = "" And (Nah - arrA(Cnt, 1)) >= 150 Then rngA.Item(Cnt).Interior.Color = vbYellow
End If
Next Cnt
End Sub

Possibly Solution 2: This would be an advancement and modification to Solution 1: Procedure Sub ChkChqe() from above, could be converted into an “Events type” procedure . This would then run the routine automatically when you changed any value. This would simply save you having to run the procedure yourself.

Alan

[msiyab]

Hello msiyab,
Possibly Solution 1: This could be to refresh the range of dates in column A so that initially all the yellow highlighting is cleared.
( We do not want to risk changing anything you have in cells A1 and A2, so we can use the Offset( , ) property on the range followed by the Resize( , ) Property to adjust the range dimensions. )

This solution seems to be working. But I need to run the macro manually to update the conditional formatting every time.



Possibly Solution 2: This would be an advancement and modification to Solution 1: Procedure Sub ChkChqe() from above, could be converted into an “Events type” procedure . This would then run the routine automatically when you changed any value. This would simply save you having to run the procedure yourself.



How can we make this file a "Events type" macro so that the macro runs automatically?

[DocAElstein]

Hello msiyab,

Some “Event type” procures are already written: Those that we need are already written.
But
_1 They are Hidden
_2 There is no coding in them
_3 We may want to modify our coding slightly when using as an events type macro

_1 We need to get at them.
One way would be to double click on the code module for the worksheet in the VB Editor window.
Or: 1_ right click on tab
__ 2_ View Code
WorksheetObjectCoding.JPG : https://imgur.com/qztsCyn
2166
We select the procedure that which we want to see
SelectWorksheet Procedures.JPG : https://imgur.com/in4TLp3
2167
Worksheet Change Procedure.JPG : https://imgur.com/20ij1Ii
2168
This coding , Private Sub Worksheet_Change(ByVal Target As Range) , runs automatically each time that you change any value in worksheet “Cheques”
( Target is the range object of the range that you change )

_2 We can put our coding in it.. ( without our End or Sub ChkChqe() )
Our Coding in Worksheet Code module.JPG : https://imgur.com/77hUaOF
2169

_3
We do not need Ws1, because all is referring to the worksheet of the worksheet code module

Private Sub Worksheet_Change(ByVal Target As Range)
'Sub ChkChqe()
'Dim Ws1 As Worksheet
' Set Ws1 = ThisWorkbook.Worksheets.Item(1)
Dim rngA As Range: Set rngA = Range("A1:A" & UsedRange.Rows.Count & "")
Let rngA.Offset(2, 0).Resize(UsedRange.Rows.Count - 2, 1).Interior.TintAndShade = 0
Dim rngL As Range: Set rngL = Range("L1:L" & UsedRange.Rows.Count & "")
Dim arrA() As Variant, arrL() As Variant
Let arrA() = rngA.Value2: Let arrL() = rngL.Value2
Dim Nah As Long: Let Nah = Now
Dim Cnt As Long
For Cnt = 3 To UsedRange.Rows.Count
If arrA(Cnt, 1) = "" Then
' Do nothing
Else
If arrL(Cnt, 1) = "" And (Nah - arrA(Cnt, 1)) >= 150 Then rngA.Item(Cnt).Interior.Color = vbYellow
End If
Next Cnt
'End Sub
End Sub

The code above is enough for you.
But we can make it a bit better
We can make sure that it only runs if you change column A or column L , for example like this

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Or Target.Column = 12 Then ' Column A Or Column L

‘ Do anything what you wanna do , http://www.youtuberepeater.com/watch?v=44JomxG4it8
‘ http://www.youtuberepeater.com/watch?v=8GoN-y9irn4&name=Eddie+and+the+Hot+Rods+Do+anything+you+wanna

Else
' Do Nothing
End If
End Sub

Final coding:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Or Target.Column = 12 Then
'Sub ChkChqe()
'Dim Ws1 As Worksheet
' Set Ws1 = ThisWorkbook.Worksheets.Item(1)
Dim rngA As Range: Set rngA = Range("A1:A" & UsedRange.Rows.Count & "")
Let rngA.Offset(2, 0).Resize(UsedRange.Rows.Count - 2, 1).Interior.TintAndShade = 0
Dim rngL As Range: Set rngL = Range("L1:L" & UsedRange.Rows.Count & "")
Dim arrA() As Variant, arrL() As Variant
Let arrA() = rngA.Value2: Let arrL() = rngL.Value2
Dim Nah As Long: Let Nah = Now
Dim Cnt As Long
For Cnt = 3 To UsedRange.Rows.Count
If arrA(Cnt, 1) = "" Then
' Do nothing
Else
If arrL(Cnt, 1) = "" And (Nah - arrA(Cnt, 1)) >= 150 Then rngA.Item(Cnt).Interior.Color = vbYellow
End If
Next Cnt
'End Sub
Else
' Do Nothing
End If
End Sub


Alan



Ref
http://www.excelfox.com/forum/showthread.php/2294-WithEvents-of-Excel-Application-Events
http://www.youtuberepeater.com/watch?v=44JomxG4it8
‘ http://www.youtuberepeater.com/watch?v=8GoN-y9irn4&name=Eddie+and+the+Hot+Rods+Do+anything+you+wanna

[msiyab]

Do I need to do all the steps from the top of your above post or only the "Final Coding" part?

[DocAElstein]

The final coding is your final code. That is the only coding that you need
But
You need to put that in a worksheet code module, the worksheet code module for worksheet “Cheques” - The steps before are to explain to you how to do that. The procedure , Private Sub Worksheet_Change(ByVal Target As Range) , will not work in a normal code module. It must be put in worksheet code module for worksheet “Cheques”


Edit: attached File is in final form

[msiyab]

Yippi!! Its working now.

Thanks a lot DocAElstein. Thanks for being so patient and really appreciate the explanation given (step-by-step)

[DocAElstein]

..Thanks a lot ...Yous welcome, thanks for the feedback :-)
Alan