week before end of month excluding public holidays and weekends

[dark11984]

Hi,
I'm trying to write a code to caluclate the working day a week before the end of the month. I've found similar codes from various places on the net and tried to use them where i can but no luck.

If the date is 7 days before end of month and its a weekend or a public holiday then i want it to minus a day until it reaches the previous working day. I created a public holiday table that stores all public holidays for the year.

Any help would be much appreciated. Thanks.
Public Function WeekBeforeEOM() As Date

Dim Searching As Boolean
Dim LastWorkday As Date
Dim i As Integer
Searching = True
LastWorkday = DateSerial(Year(Date), Month(Date) + 1, 0) '-- Start at the last day of the month
i = 1
Do While Searching
If Weekday(LastWorkday, vbMonday) <= 5 Then
If IsNull(DLookup("[HoliDate]", "tblHolidays", "[HoliDate] = " & LastWorkday)) Then
LastWorkday = LastWorkday - 7
Searching = False
Else
WeekBeforeEOM = LastWorkday - 7 - i
Searching = False
End If
End If
i = i + 1
Searching = False
Loop

End Function

 

[vbaInet]

I think you're on track but try this:

1. Get the lastworkday (which you've done)
2. Do While Weekday() = 1 OR Weekday() = 7, if it is weekend subtract ONE day from it and set that new date to the Lastday variable. Once this is satisfied it will automatically come out of the loop.
3. Instead of DLookup() use a DCount() function and perform the same check as in step 2. Do While DCount() <> 0.

Edit: Changed the AND to OR in step 2.

 

[dark11984]

I think i've done what you suggested? BUt i'm getting an overflow error and the SendDate is showing as 01/01/100 when i move the cursor over it.

Public Function WeekBeforeEOM() As Date
Dim LastWorkday As Date
Dim SendDate As Date
LastWorkday = DateSerial(Year(Date), Month(Date) + 1, 0)
SendDate = lastworkingday - 7
   
Do While Weekday(LastWorkday, vbSunday) = 1 Or Weekday(LastWorkday, vbSunday) = 7
    If Weekday(LastWorkday, vbSunday) = 1 Or Weekday(LastWorkday, vbSunday) = 7 Then
        SendDate = SendDate - 1
    Else
        SendDate = SendDate
    End If
Loop
   
Do While DCount("[HoliDate]", "tblHolidays", "[HoliDate] = " & LastWorkday) <> 0
    If DCount("[HoliDate]", "tblHolidays", "[HoliDate] = " & LastWorkday) <> 0 Then
        SendDate = SendDate - 1
    Else
        SendDate = SendDate
    End If
Loop
End Function

 

[vbaInet]

I don't know what SendDate is for. You're getting an overflow because you're not changing the value of Lastworkday inside the loop so it is endlessly iterating.

So here is one for Lastworkday:

Public Function WeekBeforeEOM() As Date
    Dim LastWorkday As Date
    LastWorkday = DateSerial(Year(Date), Month(Date) + 1, 0)
       
    Do While Weekday(LastWorkday, vbSunday) = 1 Or Weekday(LastWorkday, vbSunday) = 7
        LastWorkday = LastWorkday - 1
    Loop

    Do While DCount("*", "tblHolidays", "[HoliDate] = #" & LastWorkday & "#") <> 0
        LastWorkday = LastWorkday - 1
    Loop
End Function

If you want to do the same for SendDate then you need to repeat the same process for SendDate. That loop is specifically for LastWorkday.

You could create a parameter in that function to which you will send a Date and it will return a non-weekend/non-bank-holiday date.

 

[dark11984]

Thanks very much for your help... Here's the working code that i finished up with.

Public Function WeekBeforeEOM() As Date
Dim SendDate As Date
SendDate = DateSerial(Year(Date), Month(Date) + 1, -7)
   
Do While Weekday(SendDate, vbSunday) = 1 Or Weekday(SendDate, vbSunday) = 7
    SendDate = SendDate - 1
Loop
   
Do While DCount("*", "tblHolidays", "[HoliDate] = #" & SendDate & "#") <> 0
    SendDate = SendDate - 1
Loop
End Function

 

[vbaInet]

Goodie!!! You're welcome.

By the way, you can add all three conditions in one loop. Just use an OR to add the third DCount() condition merging it with the first loop.

Good luck!

 

[dark11984]

cool.. i've done that now.

A new issue now though. I am now trying to to run an if statement in another function referencing back to WeekBeforeEOM() such as

 If Date = WeekBeforeEOM() Then
            

        MyMail.Subject = "Week Before End of Month Email - " & [CurrentMth]

        MyMail.Body = "Week Before End of Month Email"
                            
    ElseIf Date = TwoDaysBeforeEOM() Then
    
        MyMail.Subject = "Two Days Before End of Month Email - " & [CurrentMth]
         
        MyMail.Body = "Two Days Before End of Month Email"
        
    ElseIf Date <> WeekBeforeEOM() Or Date <> TwoDaysBeforeEOM() Then
        Exit Function
                
    End If

 

[vbaInet]

New issues normally require a New Thread but here, you can send the value of SendDate to the function like below. Since you're using the value of WeekBeforeEOM more than once you're better off saving the value into a variable and calling that value as shown below:

Public Function WeekBeforeEOM() As Date
    WeekBeforeEOM = SendDate
End Function

dim myDate as Date

myDate = WeekBeforeEOM

If Date = myDate Then
...

 

[dark11984]

Many thanks.

 

[vbaInet]

No problemo