Message Box Popup on certain days help !

[DarkOne72]

Hi All,

Maybe someone can assist me in trying to get this code to work? I have half of it working but not the month end part.
What I need:

When launching the database or if it is already loaded and you show all records and it is a Friday then show the message in a popup box saying "Please Run Your Weekly Report at EOD!" which works.
However, if it is the last Friday at the end of the month then I want another message box to appear saying "Please Run Your Monthly Reports at EOD!", this part doesn't work.
​

Please see the code I have below and maybe someone can assist me in getting it correct.

The Function/Module1:

Function eom(ByVal Input_Date As Date) As Date
    
eom = DateAdd("d", -1, DateAdd("m", 1, DateSerial(Year(Input_Date), Month(Input_Date), 1)))

End Function

The code behind the On-Timer event
with interval of 0

Private Sub Form_Timer()

Dim p_dtDate As Date

MonthEnd = eom(Now())

'Weekday 1=Sunday, 2=Monday, 3=Tuesday, 4=Wednesday, 5=Thursday, 6=Friday, 7=Saturday
If Weekday(Now()) = 6 Then
MsgBox ("Please Run Your Weekly Report at EOD!")


If Weekday(Now()) = MonthEnd Then
MsgBox ("Please Run Your Monthly Reports at EOD!")

End If
End If
End Sub

Can someone please help?
Thanks in advance.

 

[Andrzejek]

What you can do is...
You already get the Friday. To check if the Friday you have is the last Friday of the month, just add a week to it and check if the next Friday is in the same month or not:

Just a simple 'proof of concept':

Dim dat As Date
Dim dat1 As Date

dat = Date
Debug.Print dat
dat1 = DateAdd("ww", 1, Date)
Debug.Print dat1

If Month(dat) = Month(dat1) Then
    Debug.Print "Both dates are in the samo month"
Else
    Debug.Print "dat1 is in the next month"
End If

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[DarkOne72]

Thank you Andy for the reply but I am confused...
Is the code you provided replacing my code or am I adding it in between somewhere?

 

[Andrzejek]

I can give you your code with [blue]a little modification/addition[/blue]:

Option Explicit

Sub test()
Dim MonthEnd As Date[blue]
Dim blnIsLastFri As Boolean[/blue]

MonthEnd = eom(CDate("7/19/2024"), [blue]blnIsLastFri[/blue])

Debug.Print MonthEnd
Debug.Print "Is it a Last Friday: " & blnIsLastFri

End Sub

Function eom(ByVal Input_Date As Date, [blue]Optional ByRef LastFriday As Boolean = False[/blue]) As Date
    
eom = DateAdd("d", -1, DateAdd("m", 1, DateSerial(Year(Input_Date), Month(Input_Date), 1)))
[blue]
If Weekday(Input_Date) = 6 Then
    If Month(Input_Date) = Month(DateAdd("ww", 1, Input_Date)) Then
        LastFriday = False
    Else
        LastFriday = True
    End If
End If
[/blue]
End Function

I hard-coded it for "7/19/2024" because I tested it for "7/26/2024" as well

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Andrzejek]

I just realized, your [tt]Function eom[/tt] doesn't really do anything, it is not used. It just tells you the last day/date of the month.

All what you really need is this:

Private Sub Form_Timer()

If Weekday(Date) = [red]vbFriday[/red] Then[blue]
    If Month(Date) = Month(DateAdd("ww", 1, Date)) Then[/blue]
        MsgBox ("Please Run Your Weekly Report at EOD!")
    Else
        MsgBox ("Please Run Your Monthly Reports at EOD!")
    End If
End If

End Sub

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[DarkOne72]

Thank you Andy, I will try this out... you're amazing !

 

[DarkOne72]

Andy,

I did test it and it worked but I found a flaw in my own logic once it worked.
What if the last day of the month was on a different week day, Or if its on a sat or Sunday I need it to show up on the Friday before that Sat or Sun.
I still will need the weekly report to run every Friday.

In Short, I need the month portion to either show up on the weekday of the end of month or the Friday before if it is end of month on the weekend.

example: If end of month is Saturday then I need the popup to show up on the Friday before that Sat.
If it ends on Wednesday then show up popup end of month box on Wednesday

 

[Andrzejek]

if the last day of the month was on a different week day

The way I understand - this report is run 'by hand' by the user(s) of your application, so it can be run M-F (I assume people do not work weekends).

You want the weekly report to be run every Friday.
And do you want the monthly report to be run last Friday of the month [red]or[/red] at the last workday of the month?

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[DarkOne72]

Yes, the popups are just reminders for them to run them manually and you're correct they do not work weekends.

I Want the msg popup to appear every Friday for the weekly report quote.
When the last day of the month comes around I want it to appear on the day it is as long as it is Mon-Fri , if the end of month falls on a Sat or Sun then make it display on the Friday before it would end on the weekend.
SO like you said the last workday of the month.

Sorry for the crew up on logic in the beginning.

 

[Andrzejek]

How about...

Private Sub Form_Timer()
Dim strMsg As String

If Weekday(Date) = vbFriday Then
    strMsg = "Please Run Your Weekly Report at EOD!"
End If

If Day(Date) > 25 Then[green]
    'No reason to check before the 26th[/green]
    If Date = LastWorkday Then
        If Len(strMsg) Then
            strMsg = strMsg & vbNewLine & vbNewLine & _
                "and also" & vbNewLine
        End If
        
        strMsg = strMsg & "Please Run Your Monthly Reports at EOD!"
    End If
End If

MsgBox strMsg

End Sub

Private Function LastWorkday() As Date
Dim datDay As Date
Dim blnFoundIt As Boolean
[green]
'Get the last day of curent month[/green]
datDay = DateSerial(Year(Date), Month(Date) + 1, 0)

Do
    Select Case Weekday(datDay)
        Case vbSaturday, vbSunday[green]
            'Subtract a day if weekend[/green]
            datDay = DateAdd("d", -1, datDay)
        Case Else
            blnFoundIt = True   [green]'BINGO[/green]
    End Select
Loop Until blnFoundIt

LastWorkday = datDay

End Function

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[DarkOne72]

Hello,

I tried the code and put the function and all seems to work except the "Please Run Your Monthly Reports at EOD!" , it just gives a blank message Microsoft Access popup box. This was putting my date and time to July 31 which is a Wednesday. I also tried it on June 28th which is a Friday for both Weekly and Monthly reports due It only shows the weekly and no additional popup or addition in verbiage.

This is amazing, thank you for your help, there isn't anyway I would have even came close to that.

 

[combo]

It seems that the system date was not changed.

The function above returns empty string even if none of conditions is satisfied, change:
[tt]MsgBox strMsg[/tt]
to:
[tt]If Len(strMsg) Then MsgBox strMsg[/tt]

For testing I used a call with custom date, it is safer and taster than playing with system dates (with slight modifications):

Sub Test2()
Dim datRef As Date

datRef = DateSerial(2024, 7, 31)
Call TestReportsMsg(datRef)
End Sub

Sub TestReportsMsg(datTestDate As Date)
Dim strMsg As String

If Weekday(datTestDate) = vbFriday Then
    strMsg = "Please Run Your Weekly Report at EOD!"
End If

If Day(datTestDate) > 25 Then
    'No reason to check before the 26th
    Dim datEOM As Date
    'Get the last day of curent month
    datEOM = DateSerial(Year(datTestDate), Month(datTestDate) + 1, 0)
    Do
        Select Case Weekday(datEOM)
        Case vbSaturday, vbSunday
            'Subtract a day if weekend
            datEOM = datEOM - 1
        Case Else
            Exit Do   'BINGO
        End Select
    Loop
    
    If datTestDate = datEOM Then
        If Len(strMsg) Then
            strMsg = strMsg & vbNewLine & vbNewLine & _
                "and also" & vbNewLine
        End If
        
        strMsg = strMsg & "Please Run Your Monthly Reports at EOD!"
    End If
End If

If Len(strMsg) Then MsgBox strMsg

End Sub

In real you can use call with system date:

Private Sub Form_Timer()
Call TestReportsMsg(Date)
End Sub

combo

 

[Andrzejek]

Yes, the:
[tt]If Len(strMsg) Then MsgBox strMsg[/tt]
should fix the empty message box, but...

You rely on user(s) to be at work on Fridays, be present on last day of the month, and remember to run report(s) at the end of the day.
In my opinion it would be a lot better if you would write a little code, create a file, schedule it to run on Friday nights (or Saturday morning) for weekly report, and run monthly report early in the morning on the 1st of every month.
No reminders, no checks, nobody needs to be involved, etc. And after creating the report, just send an email to whoever needs to be notified:
"Your weekly/monthly report is ready for you at [place location of the report here]. Enjoy."

Just a suggestion...

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[DarkOne72]

Thank you so much for everything I will put the code in and try it in real world this month end coming.
One of the reason it isn't automated like you suggested (as I wanted to do as well) they wanted to make it manual and up to them to complete.
Please check back on or after 8-1 and see the results from real world

 

[strongm]

Ah, this brings back memories of long discussions (and solutions) to determine first or last business days, or the last and first nominated day of any given month in the vb6 forum (fx: quick check) <gulp> over 20 years ago ...

They may be of some interest, so:
thread222-147546
thread222-360830

 

[Andrzejek]

they wanted to make it manual and up to them to complete.

Sooner or later 'they' will realize there are holidays on Fridays and on the last business days as well. Nobody is at work to run it.

strongm,
The weirdest date calculation I had to do was: from a given date, calculate first Tuesday of the month - 2 months prior to a given date. Not that complicated after all

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[strongm]

>Not that complicated after all

Nope My generic function for that can be found near the end of 22 year old thread222-360830

 

[DarkOne72]

Hi Andy (and everyone else )

Unfortunately the Month end popup did not come up, however the Weekday Friday worked perfectly.
I am not sure why it didn't work as I made sure all was put in properly as stated above; there was no error it just never appeared.

Thank you again!

 

[Andrzejek]

Could you post the code you have? We will take a look and see what's going on (or, what is NOT going on... )

The best way to test it (and fix it) was last Wednesday when all stars aligned.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[DarkOne72]

Thanks Andy,

I will post it Monday evening, I am currently out of town now but I appreciate all of your help.

Rick