Pop up messages according the date of the month

**MariaPap** · 05-14-2014, 05:47 AM

Hello

I use this code(Provided by Mr Alan) that works fine.

Option Explicit
Private Sub Workbook_Open()
Dim sh As Worksheet
Set sh = Sheets("Sheet2")

If Day(Now()) = 10 Then
    MsgBox Join(Application.WorksheetFunction.Transpose(sh.Range("A1:A10").Value), Chr$(10))
    ElseIf Day(Now()) = 15 Then
        MsgBox Join(Application.WorksheetFunction.Transpose(sh.Range("B1:B10").Value), Chr$(10))
        ElseIf Day(Now()) = 20 Then
            MsgBox Join(Application.WorksheetFunction.Transpose(sh.Range("C1:c10").Value), Chr$(10))
            ElseIf Day(Now()) = 25 Then
                MsgBox Join(Application.WorksheetFunction.Transpose(sh.Range("D1:D10").Value), Chr$(10))
                ElseIf Day(Now()) = 30 Then
                    MsgBox Join(Application.WorksheetFunction.Transpose(sh.Range("E1:E10").Value), Chr$(10))
End If

End Sub

My problem is that when the specific dates of the code are in weekends or Holidays, user does not see the messages and forget to do the duties.

I need if specific days of the month that appear in the code(10,15,20,25,30) are in weekends OR Holidays the pop up message to appears the last working date BEFORE that day.

In My example as Tomorrow date is in the Holidays List, the message for DAY 15 of the month should appear today.

Thanks in advance for any assistance here!

**nathansav** · 05-14-2014, 06:22 AM

Hi

I would recommend a sub that is run before the one in the post, which sets the 5 dates. So it looks to see if its a weekend and then adjusts.

Something like

Sub SetDays()
if weekday(date(year(now()),month(now()),10),2)>6 then 
     datecheck1 = 14
else
    datecheck1 =15
end if


etc. etc.

then replace if Day(Now()) > dateCheck1 etc.

I havent tested it, but that is the approach i'd play with.

You could even set it up on a separate sheet using the same weekday formula and then look at that sheet

**ragulduy** · 05-14-2014, 06:31 AM

I'm thinking:

Sub macro_1()
Dim reminder_days(1 To 5) As Integer
Dim col As Integer
Dim i As Integer
For i = 1 To 5
    reminder_days(i) = 5 + 5 * i
    Do Until WorksheetFunction.CountIf(Range("G:G"), DateValue(reminder_days(i) & "/" & Month(Now) & "/" & Year(Now))) = 0 _
        And WorksheetFunction.Weekday(DateValue(reminder_days(i) & "/" & Month(Now) & "/" & Year(Now)), 2) < 6
        reminder_days(i) = reminder_days(i) - 1
    Loop
Next i
On Error Resume Next
col = WorksheetFunction.Match(day(now), reminder_days, 0)
MsgBox Join(WorksheetFunction.Transpose(Sheets("Sheet2").Range(Cells(1, col), Cells(10, col)).Value), Chr$(10))
End Sub

**MariaPap** · 05-14-2014, 07:00 AM

nathansav

Thank you but Not sure how to handle it!

ragulduy

Thanks for that. Unfortunately this(running the code) does not appears anything. It should appears the data of column B? Should it?

**ragulduy** · 05-14-2014, 07:05 AM

Hi, I put the code in a new module in your example and I got a message box as follows (based on today being the 14th).:
"15 of month
E
F
G"
which I believe is the corerct result.

However, it could be an issue with date formats (I think it assumes (dd/mm/yyyy format), try this:

Sub macro_1()
Dim reminder_days(1 To 5) As Integer
Dim col As Integer
Dim i As Integer
For i = 1 To 5
    reminder_days(i) = 5 + 5 * i
    Do Until WorksheetFunction.CountIf(Range("G:G"), DateValue(Month(Now) & "/" & reminder_days(i) & "/" & Year(Now))) = 0 _
        And WorksheetFunction.Weekday(DateValue(Month(Now) & "/" & reminder_days(i) & "/" & Year(Now)), 2) < 6
        reminder_days(i) = reminder_days(i) - 1
    Loop
Next i
On Error Resume Next
col = WorksheetFunction.Match(Day(Now), reminder_days, 0)
MsgBox Join(WorksheetFunction.Transpose(Sheets("Sheet2").Range(Cells(1, col), Cells(10, col)).Value), Chr$(10))
End Sub

**MariaPap** · 05-14-2014, 07:23 AM

YES. This works great and gives the correct results. Thank you.

May i ask this?

If i want in another application to use your code for different dates(let's say 2 ,10;22;28 of the month) will this code works for me?

**ragulduy** · 05-14-2014, 07:30 AM

This bit:

reminder_days(i) = 5 + 5 * i

is what defines the days that should be used, if you want a more generalised code:

Sub macro_1()
Dim reminder_days As Variant
Dim col As Integer
Dim i As Integer
reminder_days = Array(2, 10, 22, 28)
For i = LBound(reminder_days) To UBound(reminder_days)
    Do Until WorksheetFunction.CountIf(Range("G:G"), DateValue(Month(Now) & "/" & reminder_days(i) & "/" & Year(Now))) = 0 _
        And WorksheetFunction.Weekday(DateValue(Month(Now) & "/" & reminder_days(i) & "/" & Year(Now)), 2) < 6
        reminder_days(i) = reminder_days(i) - 1
    Loop
Next i
On Error Resume Next
col = WorksheetFunction.Match(Day(Now), reminder_days, 0)
MsgBox Join(WorksheetFunction.Transpose(Sheets("Sheet2").Range(Cells(1, col), Cells(10, col)).Value), Chr$(10))
End Sub

then you can change the numbers within the array function as neccessary.

**MariaPap** · 05-14-2014, 07:42 AM

ooooooooaaaaooooooooo!!! Thank you so much!!

Pop up messages according the date of the month

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Pop up messages according the date of the month

Re: Pop up messages according the date of the month

Re: Pop up messages according the date of the month

Re: Pop up messages according the date of the month

Re: Pop up messages according the date of the month

Re: Pop up messages according the date of the month

Re: Pop up messages according the date of the month

Re: Pop up messages according the date of the month

Thread Information

Users Browsing this Thread

Similar Threads

Sort month/date/year data using month and date only

[SOLVED] Need Help Resolving Error Messages with Nestled IF and Date functions

Array function for date(month), Range Date(month)

[SOLVED] Issue FAQ for posting messages not up to date

[SOLVED] Date arithmetic: adding 1 month to prior end of month date

Bookmarks

Bookmarks

Posting Permissions