Alerts based on current Day/Week of the Month

[NearImpossible]

I'm stepping outside of my comfort zone on this one, and would like for my database to kick off some alerts based on the day of the Week/Month when the main form is opened. The alerts would be set based on the 1st Monday, 1st Tuesday, 2nd Wednesday, 2nd, Thursday, etc.

I found the following Function

' Calculates the date of the occurrence of Weekday in the month of DateInMonth.
'
' If Occurrence is 0 or negative, the first occurrence of Weekday in the month is assumed.
' If Occurrence is 5 or larger, the last occurrence of Weekday in the month is assumed.
'
' If Weekday is invalid or not specified, the weekday of DateInMonth is used.
'
' 2016-06-09. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateWeekdayInMonth( _
    ByVal DateInMonth As Date, _
    Optional ByVal Occurrence As Integer, _
    Optional ByVal Weekday As VbDayOfWeek = -1) _
    As Date

    Const DaysInWeek    As Integer = 7

    Dim Offset          As Integer
    Dim Month           As Integer
    Dim Year            As Integer
    Dim ResultDate      As Date

    ' Validate Weekday.
    Select Case Weekday
        Case _
            vbMonday, _
            vbTuesday, _
            vbWednesday, _
            vbThursday, _
            vbFriday, _
            vbSaturday, _
            vbSunday
        Case Else
            ' Zero, none or invalid value for VbDayOfWeek.
            Weekday = VBA.Weekday(DateInMonth)
    End Select

    ' Validate Occurence.
    If Occurrence <= 0 Then
        Occurrence = 1
    ElseIf Occurrence > 5 Then
        Occurrence = 5
    End If

    ' Start date.
    Month = VBA.Month(DateInMonth)
    Year = VBA.Year(DateInMonth)
    ResultDate = DateSerial(Year, Month, 1)

    ' Find offset of Weekday from first day of month.
    Offset = DaysInWeek * (Occurrence - 1) + (Weekday - VBA.Weekday(ResultDate) + DaysInWeek) Mod DaysInWeek
    ' Calculate result date.
    ResultDate = DateAdd("d", Offset, ResultDate)

    If Occurrence = 5 Then
        ' The latest occurrency of Weekday is requested.
        ' Check if there really is a fifth occurrence of Weekday in this month.
        If VBA.Month(ResultDate) <> Month Then
            ' There are only four occurrencies of Weekday in this month.
            ' Return the fourth as the latest.
            ResultDate = DateAdd("d", -DaysInWeek, ResultDate)
        End If
    End If

    DateWeekdayInMonth = ResultDate

End Function

That I can call to get the 1st, 2nd, 3rd Monday, etc,

Private Sub Command0_Click()
    FirstMonday = DateWeekdayInMonth(Date, 1, vbMonday)
    SecondMonday = DateWeekdayInMonth(Date, 2, vbMonday)
    ThirdMonday = DateWeekdayInMonth(Date, 3, vbMonday)
    FourthMonday = DateWeekdayInMonth(Date, 4, vbMonday)

     If Date = DateWeekdayInMonth(Date, 3, vbMonday) Then
         MsgBox "Third Monday: " & ThirdMonday
     End If
End Sub

but I would like to automate it based on the current date, as well as calculate for those months where there are more than 4 weeks to determine if its the 4th Monday or the Last Monday of the Month, etc

I'm sure the answer is in the function above as its already dealing with the weeks/days, but as I said before, its beyond my knowledge if anyone would like to break it down for me

Do I just manually code each day similar to the above? If so, how I do determine if its the 4th Friday or the Last Friday if the month has more than 4 weeks?

Am I way off base on this ?

Any help is greatly appreciated

 

[arnelgp]

I wrote somewhat similar functions way back, with the help of another function:

'http://www.cpearson.com/excel/datetimevba.htm
Public Function NthDayOfWeek(Y As Integer, m As Integer, _
    n As Integer, DOW As VbDayOfWeek) As Date

    NthDayOfWeek = DateSerial(Y, m, (8 - Weekday(DateSerial(Y, m, 1), _
     (DOW + 1) Mod 8)) + ((n - 1) * 7))

End Function

'arnelgp
Public Function TodayIsNthDay(dt As Date) As String
Dim Counter1 As VbDayOfWeek, Counter2 As Integer
Dim resultDate As Date
Dim bolFound As Boolean
For Counter1 = vbSunday To vbSaturday
    For Counter2 = 1 To 5
        resultDate = NthDayOfWeek(Year(dt), Month(dt), Counter2, Counter1)
        If resultDate = dt Then
            bolFound = True
            Exit For
        End If
    Next
    If bolFound Then
        Exit For
    End If
Next
TodayIsNthDay = Counter1 & _
               Choose(Counter1, "st", "nd", "rd", "th", "th", "th", "th") & " " & _
               "day of the week, " & _
               Counter2 & _
               Choose(Counter2, "st", "nd", "rd", "th", "th") & " " & _
               Format(resultDate, "dddd") & " of " & _
                Format(resultDate, "mmmm") & ", " & Year(resultDate)
End Function

today is February 18, 2018.
if you call the function in immediate window:

?TodayIsNthDay(Date)

result:

"3rd day of the week, 3rd Tuesday of February, 2020"

 

[moke123]

I 've been trying to learn dictionaries so I threw this together for fun.

Function DaysOfTheMonth(dte As Date) As String
'need reference to MS Scripting runtime
    Dim dict As New dictionary
    Dim FirstDay As Date
    Dim vDate As Date
    Dim nDay As Integer
    Dim i As Integer
    Dim StrD As String
    FirstDay = DateSerial(Year(dte), Month(dte), 1)

    If Not IsDate(dte) Or IsNull(dte) Then
        Exit Function
    End If

    For i = 1 To 7

        vDate = FirstDay

        nDay = 1

        Do While Month(dte) = Month(vDate)

            If Weekday(vDate) = i Then

                StrD = getNthDay(nDay) & " " & Format(vDate, "dddd") & " of " & Format(vDate, "mmmm")

                dict.Add vDate, StrD

                nDay = nDay + 1

            End If


            vDate = DateAdd("d", 1, vDate)

        Loop

    Next i

    DaysOfTheMonth = dict(dte)

    Set dict = Nothing

End Function

Public Function getNthDay(Num As Integer) As String

    Dim Nth As String

    Nth = Num

    Select Case Nth
    Case 1, 21, 31
        Nth = Nth & "st"
    Case 2, 22
        Nth = Nth & "nd"
    Case 3, 23
        Nth = Nth & "rd"
    Case Else
        Nth = Nth & "th"

    End Select

    getNthDay = Nth

End Function

*** Needs a reference to MS Scripting Runtime

 

[Cronk]

Moke123, just curious. What advantage do you see dictionaries in an Access database over a lookup table? I can envisualize use of a dictionary in Word. Excel has vLookup and hLookup.

@NearImpossible , I'd caution against the use of Month. Year as variables as both are the names of vba functions which you use.

 

[moke123]

@Cronk
No advantage. I have been playing around with collections and dictionaries thanks to MajPs' challenges.
When I saw this post the dictionary routine just popped into my head so I tried it and I kinda like it.
Is there a disadvantage?
edit: I'm a little confused over your comparison of a dictionary to a lookup table or vlookup.

 

[Cronk]

@moke123
My first thought was looking up data, in which case a lookup table would save initiating a dictionary or collection each session. If a lot of lookups were required and speed was an issue, a recordset based on the table could be left open. Maybe leaving the search to dictionary internals might be faster/easier than a recordset findFirst each time.

My question was more one of pondering, and certainly not inferring use of a dictionary was inferior.

 

[moke123]

I've used collections in the past but retrieving values can be cumbersome. I really like the ease of doing that in a dictionary. For the OP's question it seemed a good fit.
I used the date as the key so retrieval is a no brainer.
I have a project thats been on hold for a while where I think this will come in handy. It involves importing a text file and parsing pieces out to several tables. In order to do so involves getting primary keys to use as foreign keys so being able to add those to the dictionary is a bonus.

 

[NearImpossible]

All thanks for the responses, I posted this question and then had something come up so I'm just getting back to it.

Arnel's post is exactly what I was looking for, I will try to implement it sometime this week and if I run into any issues, i'll be back !!.

thank you