Conditional Formatting of Dates (Multiple Criteria)

[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.

Cheque Book Register.xls

[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]

Cheque Book Register 11Feb.xls

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
WorksheetObjectCoding.jpg
We select the procedure that which we want to see
SelectWorksheet Procedures.JPG : https://imgur.com/in4TLp3
SelectWorksheet Procedures.JPG
Worksheet Change Procedure.JPG : https://imgur.com/20ij1Ii
Worksheet Change Procedure.JPG
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
Our Coding in Worksheet Code module.jpg

_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/showth...ication-Events
http://www.youtuberepeater.com/watch?v=44JomxG4it8
‘ http://www.youtuberepeater.com/watch...hing+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