Hey Muheeb, took some time as I was working on your file. What I have done is - I added two new columns
1. Report Cycle (Required) - This is to set if you'd like to update the report every Mondays, 15th Day, or 25th Day. Makes necessary changes per your selection. Please note, there's a code behind the sheet (macros) so Undos won't work (as changes made by macros don't support Undo) to the Expiry Dates if the changes are made using this option.
2. Activity Expired (Additional) - Highlights the reports which have already expired. I thought you'd need to know which all processes / activities have already expired so that you can make respective changes to their next update time.
Code changes : have been made in Worksheet - Sheet1 and to the general macro - CheckForExpiryDates()
1. Codes for Sheet1:
Dim multicol As Long
Private Sub Worksheet_Change(ByVal Target As Range)
'>>> Makes sure that the variable if set to empty
multicol = 0
If Selection.Count > 1 And Selection.Count < 65536 Then multicol = Selection.Count
'>>> Does Nothing when using Filldown if the first cell is Empty
'>>> i.e. when you're trying to copy Validation with no data
If Selection(1).Value = "" Then Exit Sub
'>>> Checks if the selected column is same as that of the Named range :- "vReportNeeds"
'>>> which is nothing but column "E:E"
If Target.Column = Range("vReportNeeds").Column Then
'>>> An extra piece of code that stops / runs some of the services
'>>> of the Excel application that makes the Macro run faster / slower
BoostMacroPerformance True
'>>> Loops through each cell in the selection
For Each sCell In Selection
'>>> If the cell value is selected as Mondays Then
If sCell.Value = "Mondays" Then
'>>> Sets a formula to just one column before which would be Expiry Date
sCell.Offset(0, -1).FormulaR1C1 = "=IF(DATE(YEAR(NOW()),MONTH(NOW()),DAY(NOW()))=RC[-8],RC[-8],DATE(YEAR(NOW()),MONTH(NOW()),DAY(NOW()))+9-WEEKDAY(NOW()))"
sCell.Activate
End If
'>>> If the cell value is selected as 15th Day Then
If sCell.Value = "15th Day" Then
'>>> Checks if 15th date was already passed for the running month,
'>>> If yes, then selects next month's 15th Day
If CDate(Month(Now()) & "/" & "15" & "/" & Year(Now())) < Now Then
sCell.Offset(0, -1).Value = CDate(Month(Now()) + 1 & "/" & "15" & "/" & Year(Now()))
Else
sCell.Offset(0, -1).Value = CDate(Month(Now()) & "/" & "15" & "/" & Year(Now()))
End If
End If
'>>> If the cell value is selected as 25th Day Then
If sCell.Value = "25th Day" Then
'>>> Checks if 25th date was already passed for the running month,
'>>> If yes, then selects next month's 25th Day
If CDate(Month(Now()) & "/" & "25" & "/" & Year(Now())) < Now Then
sCell.Offset(0, -1).Value = CDate(Month(Now()) + 1 & "/" & "25" & "/" & Year(Now()))
Else
sCell.Offset(0, -1).Value = CDate(Month(Now()) & "/" & "25" & "/" & Year(Now()))
End If
End If
Next sCell
'>>> Making sure the application services are resumed
BoostMacroPerformance False
End If
End Sub
Sub BoostMacroPerformance(bln As Boolean)
If bln = True Then
'>>> Avoids Flickering of Screen
Application.ScreenUpdating = False
'>>> Sets the Calculations to Manual to avoid calculating cells while
'>>> macro is updating the values
Application.Calculation = xlCalculationAutomatic
'>>> Makes sure no events are triggered when the values of any cells
'>>> are changed or anything that causes a trigger to be fired
Application.EnableEvents = False
'>>> Never prompts the user for any unnecessary requests like
'>>> You're merging the cells / shall I continue or not.. stuffs
Application.DisplayAlerts = False
ElseIf bln = False Then
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
End If
End Sub
2. Codes for CheckForExpiryDates() : I have just added a counter variable to keep the count of activities expired for reporting purposes (message pop-up) and changes in IF condition to make sure not to look at activities which have already been reported, i.e. Sent as you asked:
Originally Posted by
muheebrahman
is it possible to stop sending those emails again ?
counter = 0
For Each Cell In Rng.Cells
ExpiryDate = Cell.Offset(0, 3)
If DateDiff("d", Now(), ExpiryDate) > 0 And DateDiff("d", Now(), ExpiryDate) <= 1 And Cell.Offset(0, 5).Value = "Not Sent" Then
counter = counter + 1
Mail_Subj = Cell.Offset(0, 1).Value
SendEmail Cell.Offset(0, 2), Mail_Subj, Mail_Msg
Cell.Offset(0, 6) = Now()
End If
Next Cell
If counter > 0 Then
MsgBox "Activities that were about to expire : " & counter & Chr(13) & "Have informed to all via mail", vbInformation, "Mail Sent Successfully"
Else
MsgBox "No activities were about to expire. Sheet is all up-to-date", vbInformation, "Mail Sent Successfully"
End If
Attached is the file. Try playing with it, and let me know for if this is not something you've been expecting.
Bookmarks