Conditional Formatting of Dates (Multiple Criteria)
4 Attachment(s)
Do Anything Ya Wanna Do .. automatically
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
Attachment 2166
We select the procedure that which we want to see
SelectWorksheet Procedures.JPG : https://imgur.com/in4TLp3
Attachment 2167
Worksheet Change Procedure.JPG : https://imgur.com/20ij1Ii
Attachment 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
Attachment 2169
_3
We do not need Ws1, because all is referring to the worksheet of the worksheet code module
Code:
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
Code:
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:
Code:
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
