Word 2010 VBA Macro to Account for Holidays

[lukeb]

Hi, I don't know VBA at all and need help for my date stamp project.
I get huge stacks of claims every day from the mail room who gets them 1 day before me Tuesday through Friday and 3 days before me for Mondays (they get them on Friday for Mondays). I already have got help to create a macro to take care of normal work weeks without any holidays involved.

What I need help with some VBA to take care of holidays so that my code of:




Sub
AutoOpen()
Dim
Shp As Shape, Shp2 As Shape, sDate As String, iDelay As
Integer
Dim oCC As
ContentControl

If Format(Now(),
“ddd”) = “Mon” Then
iDelay = 3
Else
iDelay = 1
End
If sDate = Format(Now() – iDelay, “dddd, MMMM dd, yyyy”)

Set oCC =
ActiveDocument.SelectContentControlsByTitle(“PublishDate”).Item(1)
oCC.Range.Text =
sDate
End Sub


can be extended to account for Holidays as follows:

New Year's Day 1/1/13 Always
Martin Luther King Day 1/21/13 Variable (3rd Monday of January)
President's Day 2/18/13 Variable (3rd Monday of February)
Memorial Day 5/27/13 Variable (Final Monday of May)
Independence Day 7/4/13 Always
Labor Day 9/2/13 Variable (1st Monday of September)
Thanksgiving Day (& Friday) 11/28/13 & 11/29/13 Variable (4th Thursday and Friday of November)
Christmas Day 12/25/13 Always

I have been trying and trying anything, any samples, to try to understand VBA code, but I can't seem to figure anything out that will work. I have some VBA examples that are probably leaning in the right direction and can share those upon request.

I am hoping that this VBA syntax can help and just be customized for what I am trying to do:




Public Function isHoliday(wDate As Date) As Integer
Dim sDate As Date
Dim tDate, tYear As Integer
tDate = EasterDate(Year(wDate))
sDate = tDate
Select Case wDate
Case DateValue(Year(wDate)& “-01-01”)
isHoliday = 1 ‘ New Year’s day
Case DateValue(Year(wDate)& “-07-04”)
isHoliday = 1 ‘ Independence Day
Case DateValue(Year(wDate)& “-05-01”)
isHoliday = 1 ‘ Labor Day
Case DateSerial(Year(wDate), 11, 29 – WeekDay(DateSerial(Year(wDate), 11, 1), vbFriday))
isHoliday = 1 ‘ Thanksgiving
Case NDow(Year(wDate), 1, 3, vbMonday)
isHoliday = 1 ‘ Martin Luther King Day
Case tDate
isHoliday = 1 ‘ Easter Sunday
Case DateValue(Year(wDate)& “-12-25”)
isHoliday = 1 ‘ Christmas Day
End
Select
End
Function


Please someone help me with this so that I may resume my other work activities.....

[gmaxey]

Here is some code to that determines if a given date is a holiday:

Option Explicit
Private Type typHoliday
bIsHoliday As Boolean
strDay As String
End Type
Sub IsDateAHoliday()
Dim typDay As typHoliday
'Test using this procedure.
typDay = fcnIsHoliday("11/29/2013")
MsgBox typDay.bIsHoliday & " - " & typDay.strDay
lbl_Exit:
Exit Sub
End Sub
Public Function fcnIsHoliday(oDate As Date) As typHoliday
Select Case True
Case oDate = DateSerial(Year(oDate), 1, 1)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "New Year's Day"
Case oDate = DateSerial(Year(oDate), 12, 25)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Christmas Day"
Case oDate = DateSerial(Year(oDate), 7, 4)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Independence Day"
Case oDate = DateSerial(Year(oDate), 11, 11)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Veterans Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 11, 4, 5)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Thanksgiving Day"
Case oDate = DateAdd("d", 1, fcnNumbered_DayOfWeek(Year(oDate), 11, 4, 5))
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Thanksgiving Recovery Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 1, 3, 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Martin Luther King's Birthday"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 2, 3, 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Presidents Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 9, 1, 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Labor Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 5, fncNumberOfNamedDaysInMonth(Year(oDate), 5, 2), 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Memorial Day"
Case Else
fcnIsHoliday.bIsHoliday = False
fcnIsHoliday.strDay = "Just and ordinary day"
End Select
lbl_Exit:
Exit Function
End Function
Public Function fcnNumbered_DayOfWeek(lngYear As Long, lngMonth As Long, lngNumber As Long, lngDayOfWeek As Long) As Date
fcnNumbered_DayOfWeek = DateSerial(lngYear, lngMonth, (8 - Weekday(DateSerial(lngYear, lngMonth, 1), (lngDayOfWeek + 1) Mod 8)) + ((lngNumber - 1) * 7))
lbl_Exit:
Exit Function
End Function
Public Function fncNumberOfNamedDaysInMonth(lngYear As Long, lngMonth As Long, lngDayOfWeek As Long) As Long
Dim lngIndex As Long, lngRange As Long
On Error GoTo lbl_Exit
lngRange = Day(DateSerial(lngYear, lngMonth + 1, 0))
fncNumberOfNamedDaysInMonth = 0
For lngIndex = 1 To lngRange
If Weekday(DateSerial(lngYear, lngMonth, lngIndex)) = lngDayOfWeek Then
fncNumberOfNamedDaysInMonth = fncNumberOfNamedDaysInMonth + 1
End If
Next lngIndex
lbl_Exit:
fncNumberOfNamedDaysInMonth = 0
Exit Function
End Function

[lukeb]

GO NAVY!! I was in the Navy, too (USS Belleau Wood, USS Vandegrift, USS Mustin)

So I pasted your code into my Word VBA Editor and then closed the VBA Editor and then closed Word doc and then reopened it and it came up with an error saying "Compile error: User-defined type not defined"

Keep in mind that I don't know VBA so please don't find my comments offensive (just trying to learn little by little).

Would this work for the Thanksgiving Recovery Day (which is Friday after Thanksgiving right??) (I take it that it means the 11th month, 4th week, and 5th day--both Cases have that)??

Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 11, 4, 5)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Thanksgiving Day"
Case oDate = DateAdd("d", 1, fcnNumbered_DayOfWeek(Year(oDate), 11, 4, 5))
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Thanksgiving Recovery Day"

Also, I don't think the following line of code would work for every year (I am just picking on the Variable Holidays meaning they won't every year be the same):

Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 1, 3, 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Martin Luther King's Birthday"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 2, 3, 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Presidents Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 9, 1, 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Labor Day"


I actually have found some VBA syntax that accounts for the range variance but I don't know if I can customize it for my date stamping daily project (actually I think I can customize it by year but would have to keep putting in every year in its own VBA section, then when the new year comes around, delete the prior year and wrap the new year in an AutoOpen macro). Let me know if you are interested in seeing that code??

Thank you for helping me

PS Even if that code didn't come up with any errors, I don't know what I am suppose to do with it? I mean I have tried pasting in a Private Function and then use the syntax in my AutoOpen macro like this: Call HolidayExclusion (where HolidayExclusion is the name of the Function)
That didn't work though, just gave me errors??

[lukeb]

I was trying to be cheesy and came up with this really simple version (but of course, would have to updated continually or just be a super long series of If Statements): Option Explicit
Sub AutoOpen()
'Series of If Statements must be updated after the holiday in a given year passes
Dim Shp As Shape, Shp2 As Shape, sDate As String, iDelay As Integer
Dim oCC As ContentControl
If Now = 1 / 2 / 14 Then
iDelay = 2 ' post New Years Day
ElseIf Now = 1 / 21 / 14 Then
iDelay = 4 ' post Martin Luther King's Day
ElseIf Now = 2 / 18 / 14 Then
iDelay = 4 ' post President's Day
ElseIf Now = 5 / 27 / 14 Then
iDelay = 4 ' post Memorial Day
ElseIf Now = 7 / 7 / 14 Then
iDelay = 4 ' post Independence Day
ElseIf Now = 9 / 3 / 13 Then
iDelay = 4 ' post Labor Day
ElseIf Now = 12 / 2 / 13 Then
iDelay = 5 ' post Thanksgiving Day Weekend
ElseIf Now = 12 / 26 / 13 Then
iDelay = 2 ' post Christmas Day
ElseIf Format(Now(), "ddd") = "Mon" Then
iDelay = 3
Else
iDelay = 1
End If
sDate = Format(Now() - iDelay, "dddd, MMMM dd, yyyy")

Set oCC = ActiveDocument.SelectContentControlsByTitle("MailRoom Received").Item(1)
oCC.Range.Text = sDate
End Sub
I don't understand why this doesn't work?? It always does 2 days ago whenever I set my system clock on one of the days specified in the If Statement (first business day post Holiday)?? If you can help me with this one, I will get out of your hair.....

[gmaxey]

You're getting the error because the Type Statement must be at the module level:

Option Explicit
Private Type typHoliday
bIsHoliday As Boolean
strDay As String
End Type
Sub AutoOpen()
Dim Shp As Shape, Shp2 As Shape, sDate As String, iDelay As Integer
Dim oCC As ContentControl
Dim oDate As Date
Dim oTestDate As Date
Dim typDay As typHoliday
oDate = "12/2/2013" 'Testing with oDate vice Now.
If Format(oDate, "ddd") = "Mon" Then
oTestDate = DateAdd("d", -4, oDate)
typDay = fcnIsHoliday(oTestDate)
If typDay.strDay = "Thanksgiving Day" Then
iDelay = 5
Else
iDelay = 3
End If
Else
iDelay = 1
End If
sDate = Format(Now() - iDelay, "dddd, MMMM dd, yyyy")

Set oCC = ActiveDocument.SelectContentControlsByTitle("PublishDate").Item(1)
oCC.Range.Text = sDate
' If Format(Now(), "ddd") = "Mon" Then
' oTestDate = DateAdd("d", -4, Now)
' iDelay = 3
' Else
' iDelay = 1
' End If
' sDate = Format(Now() - iDelay, "dddd, MMMM dd, yyyy")
'
' Set oCC = ActiveDocument.SelectContentControlsByTitle("PublishDate").Item(1)
' oCC.Range.Text = sDate
End Sub
Sub IsDateAHoliday()
Dim typDay As typHoliday
'Test using this procedure.
typDay = fcnIsHoliday("11/29/2013")
MsgBox typDay.bIsHoliday & " - " & typDay.strDay
lbl_Exit:
Exit Sub
End Sub
Public Function fcnIsHoliday(oDate As Date) As typHoliday
Select Case True
Case oDate = DateSerial(Year(oDate), 1, 1)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "New Year's Day"
Case oDate = DateSerial(Year(oDate), 12, 25)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Christmas Day"
Case oDate = DateSerial(Year(oDate), 7, 4)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Independence Day"
Case oDate = DateSerial(Year(oDate), 11, 11)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Veterans Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 11, 4, 5)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Thanksgiving Day"
Case oDate = DateAdd("d", 1, fcnNumbered_DayOfWeek(Year(oDate), 11, 4, 5))
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Thanksgiving Recovery Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 1, 3, 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Martin Luther King's Birthday"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 2, 3, 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Presidents Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 9, 1, 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Labor Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 5, fncNumberOfNamedDaysInMonth(Year(oDate), 5, 2), 2)
fcnIsHoliday.bIsHoliday = True
fcnIsHoliday.strDay = "Memorial Day"
Case Else
fcnIsHoliday.bIsHoliday = False
fcnIsHoliday.strDay = "Just and ordinary day"
End Select
lbl_Exit:
Exit Function
End Function
Public Function fcnNumbered_DayOfWeek(lngYear As Long, lngMonth As Long, lngNumber As Long, lngDayOfWeek As Long) As Date
fcnNumbered_DayOfWeek = DateSerial(lngYear, lngMonth, (8 - Weekday(DateSerial(lngYear, lngMonth, 1), (lngDayOfWeek + 1) Mod 8)) + ((lngNumber - 1) * 7))
lbl_Exit:
Exit Function
End Function
Public Function fncNumberOfNamedDaysInMonth(lngYear As Long, lngMonth As Long, lngDayOfWeek As Long) As Long
Dim lngIndex As Long, lngRange As Long
On Error GoTo lbl_Exit
lngRange = Day(DateSerial(lngYear, lngMonth + 1, 0))
fncNumberOfNamedDaysInMonth = 0
For lngIndex = 1 To lngRange
If Weekday(DateSerial(lngYear, lngMonth, lngIndex)) = lngDayOfWeek Then
fncNumberOfNamedDaysInMonth = fncNumberOfNamedDaysInMonth + 1
End If
Next lngIndex
lbl_Exit:
fncNumberOfNamedDaysInMonth = 0
Exit Function
End Function

[Paul_Hossler]

Not as elegant as it could be


Option Explicit
'define some constants
Const cJan As Long = 1
Const cFeb As Long = 2
Const cMar As Long = 3
Const cApr As Long = 4
Const cMay As Long = 5
Const cJum As Long = 6
Const cJul As Long = 7
Const cAug As Long = 8
Const cSep As Long = 9
Const cOct As Long = 10
Const cNov As Long = 11
Const cDem As Long = 12 'cDec is reserved word

Sub AutoOpen()
Dim Shp As Shape, Shp2 As Shape, sDate As String, iDelay As Integer
Dim oCC As ContentControl
Dim iMonth As Long, iDay As Long, iWeekday As Long, iYear As Long


iYear = Year(Now)
iMonth = Month(Now)
iDay = Day(Now)
iWeekday = Weekday(Now)

'New Year's Day 1/1/13 Always
If iMonth = cJan And iDay = 1 Then
iDelay = 1

'Independence Day 7/4/13 Always
ElseIf iMonth = cJul And iDay = 4 Then
iDelay = 1


'Christmas Day 12/25/13 Always
ElseIf iMonth = cDem And iDay = 25 Then
iDelay = 1


'BTW, the variable 'On Monday' holidays would be caught by the existing 'Monday' check
'Martin Luther King Day 1/21/13 Variable (3rd Monday of January)
ElseIf iMonth = cJan And iWeekday = vbMonday And (iDay >= 16 And iDay < 24) Then
iDelay = 3


'President 's Day 2/18/13 Variable (3rd Monday of February)
ElseIf iMonth = cFeb And iWeekday = vbMonday And (iDay >= 16 And iDay < 24) Then
iDelay = 3


'Memorial Day 5/27/13 Variable (Final Monday of May)
ElseIf iMonth = cMay And iWeekday = vbMonday Then
If DateSerial(iYear, iMonth, iDay + 7) = iMonth + 1 Then iDelay = 3

'Labor Day 9/2/13 Variable (1st Monday of September)
ElseIf iMonth = cSep And iWeekday = vbMonday And (iDay >= 1 And iDay < 8) Then
iDelay = 3


'Thanksgiving Day (& Friday) 11/28/13 & 11/29/13 Variable (4th Thursday and Friday of November)
ElseIf iMonth = cNov And iWeekday = vbThursday And (iDay >= 22 And iDay < 30) Then
iDelay = 3
ElseIf iMonth = cNov And iWeekday = vbFriday And (iDay >= 22 And iDay < 30) Then
iDelay = 4

'regular ol' Monday
ElseIf iWeekday = vbMonday Then
iDelay = 3

'nothing else
Else
iDelay = 1
End If


sDate = Format(Now() - iDelay, "dddd, MMMM dd, yyyy")

Set oCC = ActiveDocument.SelectContentControlsByTitle("PublishDate").Item(1)
oCC.Range.Text = sDate
End Sub



I don't test every date and wasn't sure what you might do for IDelay, so I just guessed

Also, if (for ex.) July 4th is on a Sunday, what should happen? iDelay = 2 ?

If your rules get more complicated, then the macro might need to be made more 'robust' to handle things like that



Paul

[lukeb]

Yes, Paul's code is a little easier on a VBA newbie like myself,

1 Question: Why does this line of code look different from all other lines of code in the If Statement series (the iDelay = x like the others shows up after the other If Statement (not sure what the 2nd If Statement is doing??)

ElseIf iMonth = cMay And iWeekday = vbMonday Then
If DateSerial(iYear, iMonth, iDay + 7) = iMonth + 1 Then iDelay = 3

Thank you for being perceptive about possible Holidays falling on weekends.

Let me share this piece of code with you in hopes that you might know how to reference it in the AutoOpen macro:

Public FunctionIsWeekend(wDate As Date) AsInteger
If WeekDay(wDate) = 7 Or WeekDay(wDate)= 1 Then Is Weekend = 1
End Function

And BTW, the dates specified in the If Statement series should be the 1st business day after the Holiday passes (since I wouldn't receive the claim forms until the next business day after the Mail Room receives them anyway)....

[Paul_Hossler]

ElseIf iMonth = cMay And iWeekday = vbMonday Then
If DateSerial(iYear, iMonth, iDay + 7) = iMonth + 1 Then iDelay = 3

ElseIf ...


The second 'If' just checks to see if Monday in one week from today is in the next month to determine if this is the last Monday

That was the only holiday on the last monday of the month



Let me share this piece of code with you in hopes that you might know how to reference it in the AutoOpen macro:


Depends on what you're planning to do with it

Unless you're planning to use the result in a computation, you could also just make it into a boolean function (= True or = False)


Public Function IsWeekend(wDate As Date) As Boolean
IsWeekend = (Weekday(wDate) = vbSunday Or Weekday(wDate) = vbSaturday)
End Function

Sub drv()
If IsWeekend(Now) Then
MsgBox "Party Time"
Else
MsgBox "Still Working"
End If
End Sub



Paul

[lukeb]

So I feel most comfortable with the following code (no offense, just a VBA newbie) and I am going to provide you with an example of what I am thinking and why I don't think your code you just posted won't work for the weekends:

Oh, thank you for explaining the whole last day of Monday for Memorial Day (that makes sense even if I don't understand the numbers\VBA coding but I think I do understand that coding for Memorial Day (basically if it is May and a Monday in May and If 7 more days = the next Month, then go back 3 days since we are sure we got the last Monday of May).....cross my fingers??)

(I put some of my code guessing in the line for Christmas because I am thinking something like If it is the next business day after Christmas, I need to go back however many days ago the Mail Room received the claims and of course, that would be effected by weekends and holidays. Basically, my guess coding says that if 12/26 is a Weekend, go back 3 days, but that wouldn't be correct if 12/25 was a Friday (day off), it should be go back 4 days since Monday I would get them and have to go back to Thursday).....



Sub testAutoOpen()
Dim Shp As Shape, Shp2 As Shape, sDate As String, iDelay As Integer
Dim oCC As ContentControl
If Date = DateSerial(Year(Date), 1, 2) Then
iDelay = 2 ' post New Years Day
ElseIf Date = NDow(Year(Date), 1, 3, vbTuesday) Then '(I can see that vb[day of week] tells the 1, 3 to pick the 3rd week in the month of January since it is 1, 3 or 1(January), 3(3rd week of January)
'But it would have to be that line + 1 right? Because we don't work on that day so we would work on Tuesday, the day after the 3rd Monday in January (not sure the correct syntax for + 1 day???
iDelay = 4 ' post Martin Luther King's Day
ElseIf Date = NDow(Year(Date), 2, 3, vbTuesday) Then '(same + 1 syntax needed here)
iDelay = 4 ' post President's Day
ElseIf Date = NDow(Year(Date), 5, 4, vbTuesday) Then '(same + 1 syntax needed here)
iDelay = 4 ' post Memorial Day
ElseIf Date = DateSerial(Year(Date), 7, 5) Then '(Not sure if this one is correct--I think it should be (Year(Date), 7, 5) Then
(and what would happen if July 5th was a weekend?? Maybe after the line Can we put something like '& If Date = DateSerial(Year(Date), 7, 5, vbMonday) Then iDelay = 3 b
ut If Date = DateSerial(Year(Date), 7, 5, vbTuesday) Then iDelay = 4 but If Date = DateSerial(Year(Date), 7, 5, vbWednesday)
Then iDelay = 2, etc., etc., etc.......
or maybe I have a function or you have a function that accounts for whether or not the holiday is a weekend or not????
iDelay = 4 ' post Independence Day
ElseIf Date = NDow(Year(Date), 9, 1, vbTuesday) Then '(Would this work for let's say September of 2015 where the first Monday of September
is on the 7th which is actually the second week of September???)
iDelay = 4 ' post Labor Day
ElseIf Date = NDow(Year(Date), 11, 4, vbThursday) Then '(this would need a + 4 since we would come back
to work the following Monday right??)
iDelay = 5 ' post Thanksgiving Day Weekend
ElseIf Date = DateSerial(Year(Date), 12, 26) & IsWeekend = True Then
iDelay = 3 ' post Christmas Day
ElseIf Weekday(Date) = vbMonday Then
iDelay = 3
Else
iDelay = 1
End If
sDate = Format(Date - iDelay, "dddd, MMMM dd, yyyy")

Set oCC = ActiveDocument.SelectContentControlsByTitle("MailRoom Received").Item(1)
oCC.Range.Text = sDate
End Sub

' We can generalize this to holidays that are defined as the Nth Day of some month,
' such as Martin Luther King's birthday, celebrated on the 3rd Monday of January.
' The following function will return the Nth DayOfWeek for a given month and year:
'SYntax NDOW:
' y = Year
' M = Month
' N = Nth day of M month
' DOW = Day of the week: 1 = Sunday, 2= Monday, etc.
Public Function NDow(y As Integer, M As Integer, N As Integer, DOW As Integer) As Date
NDow = DateSerial(y, M, (8 - Weekday(DateSerial(y, M, 1), (DOW + 1) Mod 8)) + ((N - 1) * 7))
End Function


What I am thinking is something like this (only for 3 Holidays that are always on a specific day of the year which are
1. New Year's Day
2. Independence Day
3. Christmas Day
(all other ones that we get off here are Variable (3rd Monday of January (MLK Day), 3rd Monday of February (President's Day), last Monday of May (Memorial Day), 1st Monday of September (Labor Day), 4th Thursday and Friday of November(Thanksgiving)):


Public Function IsSunday(wDate As Date) As Boolean
IsSunday = (Weekday(wDate) = vbSunday)
End Function

Public Function IsSaturday(wDate As Date) As Boolean
IsSaturday = (Weekday(wDate) = vbSaturday)
End Function

Public Function IsFriday(wDate As Date) As Boolean
IsFriday = (Weekday(wDate) = vbFriday)
End Function

Public Function IsMonday(wDate As Date) As Boolean
IsMonday = (Weekday(wDate) = vbMonday)
End Function

ElseIf Date = DateSerial(Year(Date), 12, 26) & IsSunday = True Then
iDelay = 3 ' post Christmas Day
ElseIf Date = DateSerial(Year(Date), 12, 26) & IsSaturday = True Then
iDelay = 4 ' post Christmas Day
ElseIf Date = DateSerial(Year(Date), 12, 26) & IsFriday = True Then
iDelay = 2 ' post Christmas Day
ElseIf Date = DateSerial(Year(Date), 12, 26) & IsMonday = True Then
iDelay = 3 ' post Christmas Day
ElseIf Date = DateSerial(Year(Date), 12, 26) Then
iDelay = 2 ' post Christmas Day


Would this even work? What do you think of the solution?? I don't know which one would be faster or whatever (yours or mine I got elsewhere) but let me know what you think please?

[Paul_Hossler]

If I understand, you want the last business day before the holiday or weekend. I'd seen NDOW() before, but I couldn't see how you were using it.


Option Explicit
Sub testAutoOpen()
Dim Shp As Shape, Shp2 As Shape, sDate As String
Dim oCC As ContentControl

Dim dtDate As Date

dtDate = Date

'start with today, and go back until not a holiday or weekend
Do While IsHolidayOrWeekend(dtDate)
dtDate = dtDate - 1
Loop

sDate = Format(dtDate, "dddd, MMMM dd, yyyy")

Set oCC = ActiveDocument.SelectContentControlsByTitle("MailRoom Received").Item(1)
oCC.Range.Text = sDate
End Sub

Public Function IsHolidayOrWeekend(D As Date) As Boolean

'New Years Day
If D = DateSerial(Year(D), 1, 1) Then
IsHolidayOrWeekend = True

'Martin Luther King's Day
'if Today the 3rd Monday in Janurary ?
ElseIf D = NthDayOfTheMonth(Year(D), 1, 3, vbMonday) Then
IsHolidayOrWeekend = True

'President's Day
ElseIf D = NthDayOfTheMonth(Year(D), 2, 3, vbMonday) Then
IsHolidayOrWeekend = True

'Memorial Day
ElseIf D = NthDayOfTheMonth(Year(D), 5, 4, vbMonday) Then
IsHolidayOrWeekend = True

'Independence Day
ElseIf D = DateSerial(Year(D), 7, 4) Then
IsHolidayOrWeekend = True

'Labor Day
ElseIf D = NthDayOfTheMonth(Year(D), 9, 1, vbMonday) Then
IsHolidayOrWeekend = True

'Thanksgiving Day Weekend
ElseIf D = NthDayOfTheMonth(Year(D), 11, 4, vbThursday) Then
IsHolidayOrWeekend = True

'Thanksgiving Friday Weekend
ElseIf D = NthDayOfTheMonth(Year(D), 11, 4, vbFriday) Then
IsHolidayOrWeekend = True

'Christmas Day
ElseIf D = DateSerial(Year(D), 12, 25) Then
IsHolidayOrWeekend = True

ElseIf Weekday(D) = vbSaturday Then
IsHolidayOrWeekend = True

ElseIf Weekday(D) = vbSunday Then
IsHolidayOrWeekend = True

Else
IsHolidayOrWeekend = False
End If
End Function
' We can generalize this to holidays that are defined as the Nth Day of some month,
' such as Martin Luther King's birthday, celebrated on the 3rd Monday of January.
' The following function will return the Nth DayOfWeek for a given month and year:
'
'Syntax NthDayOfTheMonth:
'
' y = Year
' M = Month
' N = Nth day of M month
' DOW = Day of the week: 1 = Sunday, 2= Monday, etc.
Public Function NthDayOfTheMonth(yr As Long, mn As Long, n As Long, dow As Long) As Date
NthDayOfTheMonth = DateSerial(yr, mn, (8 - Weekday(DateSerial(yr, mn, 1), (dow + 1) Mod 8)) + ((n - 1) * 7))
End Function



Paul

[lukeb]

No, I always need the first business day after any holidays and weekends.

The reason is because our Mail Room receives the claim forms, let's say on Monday, then I get them on my desk for date stamping on Tuesday (that 1 day pattern is always there except for the Friday Mail Room receipt to Monday get them on my desk routine as well as Holidays in which I would have to skip 1 more day back to account for the holiday since no mail on holidays and of course, 2 more days back for Thanksgiving weekend)

I am not sure about all of those numbers in the math calculation for the NDOW function either because I got that code from somewhere else....

[Paul_Hossler]

If you want the next business day, just change the lines below to keep going up instead


'start with today, and go forward until not a holiday or weekend

Do While IsHolidayOrWeekend(dtDate)
dtDate = dtDate + 1
Loop



Paul

[lukeb]

So please let me understand....How does that piece of code fit into my VBA code? I am a VBA newbie....please advise me where to put it?

Actually, I don't think what that code is doing is what I need (I might be wrong)?
'start with today, and go forward until not a holiday or weekend
From that comment line, it says start with today, but actually, I would need to look into the past.
Example: If July 4th fell on a Friday, my company would be closed that day, so Mail Room would receive their claim forms on Thursday, then I would get them on Monday, forcing me to go back to Thursday date for the date stamp. If July 4th fell on a Saturday for future years, then I wouldn't have to go back more than Friday. So the code would have to take that into account.

I mean, I 'date stamp' them on the current day for prior days in the past (when the mail room receives them depending on the business day schedule)

Are you saying like this??:


Option Explicit
Sub AutoOpen()
Dim Shp As Shape, Shp2 As Shape, sDate As String, iDelay As Integer
Dim oCC As ContentControl
Dim dtDate As Date

dtDate = Date

'start with today, and go back until not a holiday or weekend
Do While IsHolidayOrWeekend(dtDate)
dtDate = dtDate - 1 (I think this is saying for any Holiday,
just go back 1 day. This would be wrong
because I would be saying the Mail Room
received them on the Holiday)
Loop

ElseIf Format(Now(), "ddd") = "Mon" Then
iDelay = 3
Else
iDelay = 1
End If
sDate = Format(Now() - iDelay, "dddd, MMMM dd, yyyy")

Set oCC = ActiveDocument.SelectContentControlsByTitle("MailRoom Received").Item(1)
oCC.Range.Text = sDate
End Sub


So it looks to me that the IsHolidayorWeekend code in your previous post needs to have something in there that accounts for Fridays and Mondays.

If Friday is a Holiday\Day off, then I would be starting from Monday (so Date() - 4 to get back to Thursday).
If Monday is a Holiday\Day off, then I would be starting from Tuesday (so Date() - 4 to get back to Friday).
If Thanksgiving weekend (only time we get 2 Holiday days off in a row), I would be starting on Monday (so Date() - 5 to get back to Wednesday).
If given Holiday is any day from Tuesday through Thursday, just need to go back 2 days (so Date() - 2 to get back to day before Holiday in that case).

Please look at post #9, the 2nd section of code....I was hoping there you would see what my newbie VBA skills were trying to do???
I tested it and it gives me a 'Compile error: Argument not Optional'?? But it did work for the Holiday I selected.....???

Also please look at my comments at post #9, the 1st section of code. I am saying that the dates specified in the function are the Holiday dates as the current date, but nobody works on those dates. The current date would be the 1st business day after the Holiday and\or weekend in which it would need to calculate the amount of days since the last business day from there (that's why I was saying things like 'this one needs a +4 or a +2)???

[gmaxey]

I understand you prefer Paul's code over mine and I have no concerns with that. However, it seems to me that you are trying to stamp documents that you get today (NOW) with the date of the previous business day. E.g. you get a document on Monday and you want to stamp it with the date of the previous Friday. You get a document on 12/2/2013 and you want to stamp it with the last business day 11/27/2013. No?

You can try this. I only did limited testing with observed dates so keep that it mind.

Sub AutoOpen()
StampPreviousBusinessDay
End Sub
Sub StampPreviousBusinessDay()
Dim oDate As Date
Dim oDateStamp As Date
Dim typDay As typHoliday
'oDate = "12/2/2013" 'Test for Thanksgiving Day
'oDate = "12/27/2011" 'Test for Chistmas Day Observed
'oDate = "1/3/2011" 'Test for New Years Day Observed on Friday
oDate = "1/3/2017" 'Test for New Years Day Observed on Monday.
'oDate = Now
oDateStamp = DateAdd("d", -1, oDate)
Do
typDay = fcnIsHolidayOrWeekend(oDateStamp)
If typDay.bIsHoliday Then
oDateStamp = DateAdd("d", -1, oDateStamp)
End If
Loop While typDay.bIsHoliday
ActiveDocument.SelectContentControlsByTitle("Publish Date").Item(1).Range.Text = Format(oDateStamp, "dddd, MMMM dd, yyyy")
lbl_Exit:
Exit Sub
End Sub
Public Function fcnIsHolidayOrWeekend(oDate As Date) As typHoliday
Select Case True
Case Weekday(oDate) = 1 Or Weekday(oDate) = 7
'Plain weekend day.
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Weekend day"
Case oDate = DateSerial(Year(oDate), 1, 1)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "New Year's Day"
Case oDate = DateSerial(Year(oDate), 12, 25)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Christmas Day"
Case oDate = DateSerial(Year(oDate), 7, 4)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Independence Day"
Case oDate = DateSerial(Year(oDate), 11, 11)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Veterans Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 11, 4, 5)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Thanksgiving Day"
Case oDate = DateAdd("d", 1, fcnNumbered_DayOfWeek(Year(oDate), 11, 4, 5))
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Thanksgiving Recovery Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 1, 3, 2)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Martin Luther King's Birthday"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 2, 3, 2)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Presidents Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 9, 1, 2)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Labor Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 5, fncNumberOfNamedDaysInMonth(Year(oDate), 5, 2), 2)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Memorial Day"
Case Else
'Is it an observed holiday
If Weekday(oDate) = 2 Then
Select Case True
Case DateAdd("d", -1, oDate) = DateSerial(Year(oDate), 1, 1)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "New Year's Day Observed"
Case DateAdd("d", -1, oDate) = DateSerial(Year(oDate), 12, 25)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Christmas Day Observed"
Case DateAdd("d", -1, oDate) = DateSerial(Year(oDate), 7, 4)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Indenpence Day Observed"
Case DateAdd("d", -1, oDate) = DateSerial(Year(oDate), 11, 11)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Veteren's Day Observed"
Case Else
fcnIsHolidayOrWeekend.bIsHoliday = False
fcnIsHolidayOrWeekend.strDay = "Just and ordinary day"
End Select
ElseIf Weekday(oDate) = 6 Then
Select Case True
Case oDate = "12/31/" & Year(oDate)
If DateAdd("d", 1, oDate) = DateSerial(Year(oDate) + 1, 1, 1) Then
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "New Year's Day Observed"
End If
Case DateAdd("d", 1, oDate) = DateSerial(Year(oDate), 12, 25)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Christmas Day Observed"
Case DateAdd("d", 1, oDate) = DateSerial(Year(oDate), 7, 4)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Indenpence Day Observed"
Case DateAdd("d", 1, oDate) = DateSerial(Year(oDate), 11, 11)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Veteren's Day Observed"
Case Else
fcnIsHolidayOrWeekend.bIsHoliday = False
fcnIsHolidayOrWeekend.strDay = "Just and ordinary day"
End Select
Else
fcnIsHolidayOrWeekend.bIsHoliday = False
fcnIsHolidayOrWeekend.strDay = "Just and ordinary day"
End If
End Select
lbl_Exit:
Exit Function
End Function
Public Function fcnNumbered_DayOfWeek(lngYear As Long, lngMonth As Long, lngNumber As Long, lngDayOfWeek As Long) As Date
fcnNumbered_DayOfWeek = DateSerial(lngYear, lngMonth, (8 - Weekday(DateSerial(lngYear, lngMonth, 1), (lngDayOfWeek + 1) Mod 8)) + ((lngNumber - 1) * 7))
lbl_Exit:
Exit Function
End Function
Public Function fncNumberOfNamedDaysInMonth(lngYear As Long, lngMonth As Long, lngDayOfWeek As Long) As Long
Dim lngIndex As Long, lngRange As Long
On Error GoTo lbl_Exit
lngRange = Day(DateSerial(lngYear, lngMonth + 1, 0))
fncNumberOfNamedDaysInMonth = 0
For lngIndex = 1 To lngRange
If Weekday(DateSerial(lngYear, lngMonth, lngIndex)) = lngDayOfWeek Then
fncNumberOfNamedDaysInMonth = fncNumberOfNamedDaysInMonth + 1
End If
Next lngIndex
lbl_Exit:
fncNumberOfNamedDaysInMonth = 0
Exit Function
End Function

[lukeb]

I copied and pasted the whole code you just provided in my VBA Editor and then closed the Editor and the document (and changed the Sub AutoOpen() to SubAutoOpenGregMaxey() to avoid ambiguous names).

After that, I opened my document and it is showing "Compile error: User-defined type not defined"

It was highlighting the Public Function fcnIsHolidayOrWeekend(oDate As Date) As typHoliday

??

And yes, you nailed it (someone gets it) about the last business day for the date stamp...Thank you

[gmaxey]

That it my fault. You must have this at the module level (directly below the Option Explicit statement if you use one):

Private Type typHoliday
bIsHoliday As Boolean
strDay As String
End Type

[lukeb]

Nope, same error. I pasted in that code you just posted and typed in Option Explicit above that all the way at the top of all your code......

[gmaxey]

Is Option Exlicit the very first line of code in the module?

[lukeb]

No it is not, please excuse my ignorance....How do I put that code into a separate module??

I hit Insert--Module and cut and pasted your code into that new module, closed VBA Editor, closed the file, reopened the file, and no more error message....

Let me test it out a bit.....

Whoa....I changed my system clock to 12/2/13 and ran your AutoOpenGregMaxey Macro and it changed the 2 Text Boxes dates to "Friday, December 30 2016" (without the quotes)???

the following code looked strange:
oDate = "1/3/2017" 'Test for New Years Day Observed on Monday. (not commented out so I commented out, changed the system clock to 1/21/14, reran your macro and it changed the Date Stamp to "December 29, 1899"???)

[gmaxey]

Did you look at the attached document. Don't change your system clock

Just change:
oDate = Now
to:
oDate = "12/2/2013" 'or some other date you want to test with.

[lukeb]

So I am starting to get happy that this is working (don't understand if you can change it to be based off the system clock and if you are just using oDate for me to test it, though???)

Here are my findings:

Test Date Functional Results
12/2/13 Worked Wednesday, November 27 2013
7/6/15 Not Working Thursday, July 02 2015 (Holiday on Weekend)
1/2/13 Worked Monday, December 31 2012
1/21/14 Worked Friday, January 17 2014
2/18/14 Worked Friday, February 14, 2014
5/27/14 Not Working Monday, May 26 2014 (Memorial Day)
7/7/14 Worked Thursday, July 03 2014
9/3/13 Worked Friday, August 30 2013
12/26/13 Worked Tuesday, December 24 2013
7/12/13 Worked Thursday, July 11 2013
7/15/13 Worked Friday, July 12 2013

Thank you so much for this magic!!!

1 more question please: Can we make the date like this:
Thursday, July 10, 2013 (notice there is a comma after July 10)

Well I am leaving work now and I will try to check the post at home......if not, will check tomorrow (I know you are on Eastern Standard Time so it will get late for you soon, anyway probably).....

[gmaxey]

I made a few adjustments. However 7/6/15 worked here. The 4th that year falls on a Saturday. So the holiday, I think, is observed Friday the 3rd. So if you get the document on the 6th, the last business day was the 2nd. No?

Dim oDate as Date
oDate = Now

Is using the system clock or at least I think it is.

Option Explicit
Private Type typHoliday
bIsHoliday As Boolean
strDay As String
End Type
Sub AutoOpen()
StampPreviousBusinessDay
End Sub
Sub StampPreviousBusinessDay()
Dim oDate As Date
Dim oDateStamp As Date
Dim typDay As typHoliday
'oDate = "12/2/2013" 'Test for Thanksgiving Day
'oDate = "12/27/2011" 'Test for Chistmas Day Observed
'oDate = "1/3/2011" 'Test for New Years Day Observed on Friday
'oDate = "1/3/2017" 'Test for New Years Day Observed on Monday.
'oDate = "5/27/14" 'Test for Memorial Day
oDate = "7/6/15" 'Test for Independence Day Observed on Friday.
'Unset and use this when done testing.
'oDate = Now
oDateStamp = DateAdd("d", -1, oDate)
Do
typDay = fcnIsHolidayOrWeekend(oDateStamp)
If typDay.bIsHoliday Then
oDateStamp = DateAdd("d", -1, oDateStamp)
End If
Loop While typDay.bIsHoliday
ActiveDocument.SelectContentControlsByTitle("Publish Date").Item(1).Range.Text = Format(oDateStamp, "dddd, MMMM dd, yyyy")
lbl_Exit:
Exit Sub
End Sub
Public Function fcnIsHolidayOrWeekend(oDate As Date) As typHoliday
Select Case True
Case Weekday(oDate) = 1 Or Weekday(oDate) = 7
'Plain weekend day.
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Weekend day"
Case oDate = DateSerial(Year(oDate), 1, 1)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "New Year's Day"
Case oDate = DateSerial(Year(oDate), 12, 25)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Christmas Day"
Case oDate = DateSerial(Year(oDate), 7, 4)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Independence Day"
Case oDate = DateSerial(Year(oDate), 11, 11)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Veterans Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 11, 4, 5)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Thanksgiving Day"
Case oDate = DateAdd("d", 1, fcnNumbered_DayOfWeek(Year(oDate), 11, 4, 5))
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Thanksgiving Recovery Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 1, 3, 2)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Martin Luther King's Birthday"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 2, 3, 2)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Presidents Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 9, 1, 2)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Labor Day"
Case oDate = fcnNumbered_DayOfWeek(Year(oDate), 5, fncNumberOfNamedDaysInMonth(Year(oDate), 5, 2), 2)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Memorial Day"
Case Else
'Is it an observed holiday
If Weekday(oDate) = 2 Then
Select Case True
Case DateAdd("d", -1, oDate) = DateSerial(Year(oDate), 1, 1)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "New Year's Day Observed"
Case DateAdd("d", -1, oDate) = DateSerial(Year(oDate), 12, 25)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Christmas Day Observed"
Case DateAdd("d", -1, oDate) = DateSerial(Year(oDate), 7, 4)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Indenpence Day Observed"
Case DateAdd("d", -1, oDate) = DateSerial(Year(oDate), 11, 11)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Veteren's Day Observed"
Case Else
fcnIsHolidayOrWeekend.bIsHoliday = False
fcnIsHolidayOrWeekend.strDay = "Just and ordinary day"
End Select
ElseIf Weekday(oDate) = 6 Then
Select Case True
Case oDate = "12/31/" & Year(oDate)
If DateAdd("d", 1, oDate) = DateSerial(Year(oDate) + 1, 1, 1) Then
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "New Year's Day Observed"
End If
Case DateAdd("d", 1, oDate) = DateSerial(Year(oDate), 12, 25)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Christmas Day Observed"
Case DateAdd("d", 1, oDate) = DateSerial(Year(oDate), 7, 4)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Indenpence Day Observed"
Case DateAdd("d", 1, oDate) = DateSerial(Year(oDate), 11, 11)
fcnIsHolidayOrWeekend.bIsHoliday = True
fcnIsHolidayOrWeekend.strDay = "Veteren's Day Observed"
Case Else
fcnIsHolidayOrWeekend.bIsHoliday = False
fcnIsHolidayOrWeekend.strDay = "Just and ordinary day"
End Select
Else
fcnIsHolidayOrWeekend.bIsHoliday = False
fcnIsHolidayOrWeekend.strDay = "Just and ordinary day"
End If
End Select
lbl_Exit:
Exit Function
End Function
Public Function fcnNumbered_DayOfWeek(lngYear As Long, lngMonth As Long, lngNumber As Long, lngDayOfWeek As Long) As Date
fcnNumbered_DayOfWeek = DateSerial(lngYear, lngMonth, (8 - Weekday(DateSerial(lngYear, lngMonth, 1), (lngDayOfWeek + 1) Mod 8)) + ((lngNumber - 1) * 7))
lbl_Exit:
Exit Function
End Function
Public Function fncNumberOfNamedDaysInMonth(lngYear As Long, lngMonth As Long, lngDayOfWeek As Long) As Long
Dim lngIndex As Long, lngRange As Long
On Error GoTo lbl_Err
lngRange = Day(DateSerial(lngYear, lngMonth + 1, 0))
fncNumberOfNamedDaysInMonth = 0
For lngIndex = 1 To lngRange
If Weekday(DateSerial(lngYear, lngMonth, lngIndex)) = lngDayOfWeek Then
fncNumberOfNamedDaysInMonth = fncNumberOfNamedDaysInMonth + 1
End If
Next lngIndex
lbl_Exit:
Exit Function
lbl_Err:
fncNumberOfNamedDaysInMonth = 0
Resume lbl_Exit
End Function

[Paul_Hossler]

Sorry, but I'm getting confused with the rules

I was going by this from the first post ...



If Format(Now(), “ddd”) = “Mon” Then
iDelay = 3
Else
iDelay = 1
End

If sDate = Format(Now() – iDelay, “dddd, MMMM dd, yyyy”)



which says that if today is Monday then the day you want is 3 days before today which would be the previous Friday, otherwise just use yesterday.


When you said that you wanted to go forward to the next business day, I did change the Loop to go forward ...


dtDate = Date

'start with today, and go forward until not a holiday or weekend
Do While IsHolidayOrWeekend(dtDate)
dtDate = dtDate + 1
Loop


This just says to start with Today, and ...

If Today is a w/e or holiday, keep checking the next day (the '+1') until that day is not a w/e or holiday.

Paul

PS (Greg's very good, even if he has the disadvantage of not being ex-Air Force :beerchug: )

[gmaxey]

LOL

[gmaxey]

Using this code and the other functions you can define advance business days:

Sub StampNextBusinessDay()
Dim oDate As Date
Dim oDateStamp As Date
Dim typDay As typHoliday
Dim lngIndex As Long, lngAdvance As Long
'oDate = "11/27/2013" 'Test for Thanksgiving Day
oDate = "12/23/2011" 'Test for Chistmas Day Observed
'oDate = "12/30/2010" 'Test for New Years Day Observed on Friday
'oDate = "12/30/2016" 'Test for New Years Day Observed on Monday.
'oDate = "5/24/2013" 'Test for Memorial Day
'oDate = "7/2/15" 'Test for Independence Day Observed on Friday.
'Unset and use this when done testing.
'oDate = Now
oDateStamp = oDate
lngAdvance = InputBox("How many business days?", "Response in Business Days", 7)

For lngIndex = 1 To lngAdvance
oDateStamp = DateAdd("d", 1, oDateStamp)
Do
typDay = fcnIsHolidayOrWeekend(oDateStamp)
If typDay.bIsHoliday Then
oDateStamp = DateAdd("d", 1, oDateStamp)
End If
Loop While typDay.bIsHoliday
Next lngIndex
ActiveDocument.SelectContentControlsByTitle("Publish Date").Item(1).Range.Text = Format(oDateStamp, "dddd, MMMM dd, yyyy")
lbl_Exit:
Exit Sub
End Sub

[lukeb]

Just got in to work:

Tested the 2 dates that were, according to me yesterday, failing, but YES GREG, you are right about Independence Day in 2015 which happens to fall on a Saturday. I tested both of those dates, and they both work fine now.

I am still fairly new here and don't know all the rules, but I asked about stuff like that and the rules are this:

1. If Holiday falls on a Saturday, then we get the Friday just before that Saturday off.

2. If Holiday falls on a Sunday, then we get the Monday just after that Sunday off.

I believe that the code works for Saturday Holidays since I can see it works for Saturday Independence Day in 2015.

I am not sure if the code has been established for Sunday Holidays to go from Tuesday following the Sunday to go back to the previous Friday (something like Date() - 4 days)............

Can we make the date like this please:
Thursday, July 10, 2013 (notice there is a comma after July 10)

Anchors Aweigh My Boys!!!

[gmaxey]

Luke,

There is a test for condition 2 in the code I posted. Posted again below.

New Year's Day falls on Sunday the 1st in 2017. So when you get that document oDate = Now will be oDate = 1/3/2017 the return for that condition is Friday, December 30, 2016.

And yes. I've noticed that there is a comma after the spelled out day and the numerical day. So here at least the date is like you show.

BTW, I was too busy with other things yesterday to properly thank you for your service in the USN and to the United States. Thank you.

Paul that goes for you and your service in the USAF as well!

Sub StampPreviousBusinessDay()
Dim oDate As Date
Dim oDateStamp As Date
Dim typDay As typHoliday
'oDate = "12/2/2013" 'Test for Thanksgiving Day
'oDate = "12/27/2011" 'Test for Chistmas Day Observed
'oDate = "1/3/2011" 'Test for New Years Day Observed on Friday
oDate = "1/3/2017" 'Test for New Years Day Observed on Monday.
'oDate = Now
oDateStamp = DateAdd("d", -1, oDate)
Do
typDay = fcnIsHolidayOrWeekend(oDateStamp)
If typDay.bIsHoliday Then
oDateStamp = DateAdd("d", -1, oDateStamp)
End If
Loop While typDay.bIsHoliday
ActiveDocument.SelectContentControlsByTitle("Publish Date").Item(1).Range.Text = Format(oDateStamp, "dddd, MMMM dd, yyyy")
lbl_Exit:
Exit Sub
End Sub

[lukeb]

Thank you Greg for your help with this project and your service to our country as well as to you Paul.

I will look more at the code after I finish the project I have going on right now at work....I don't know really know how long it will take me, but will keep you posted so that you VBA geniuses can close my request out.....

There is only one last request I believe as of now (after I get a chance to go over the code) and that is and I hope it is not too much of a stretch:

Would it be possible to include the most comments you can to explain what is going on in the code so that I can learn VBA more and more (I mean, I think I understand a lot of what is going on, maybe just the less obvious lines of code if you can allocate time for that).

I don't want to just be using the code without knowing why it works and also, I would like to pass on the legacy of helping others with VBA problems\requests to make other people's lives better\less tedious, too.

Will post back after I finish up my other work. Thank you Greg. Thank you Paul.

[gmaxey]

Luke,

The following function is a little more complex than I can confidently explain. Perhaps Jason, Gerry or even Paul will be along to clear the haze. Functions are like tools or equipment in the PMS locker. You don't always have to know how or why they work as long as you can use them to get the job done. Right?

Note: I've change the function name to make its purpose clearer.

Public Function fcn_NthWeekday(lngYear As Long, lngMonth As Long, lngNumber As Long, lngDayOfWeek As Long) As Date
fcn_NthWeekday = DateSerial(lngYear, lngMonth, (8 - Weekday(DateSerial(lngYear, lngMonth, 1), (lngDayOfWeek + 1) Mod 8)) + ((lngNumber - 1) * 7))
lbl_Exit:
Exit Function
End Function

Here is my attempt at explaining it:

Public Function fcn_NthWeekday(lngYear As Long, lngMonth As Long, lngNumber As Long, lngDayOfWeek As Long) As Date
'Takes as arguments 1) lngYear = A year 2) lngMonth = A month 3) lngNumber = The Nth (e.g., 1st, 2nd, 3rd lngDayOfWeek) _
lngDayOfWeek = A constant (e.g., 5 or vbThursday)
'So if we pass 2013, 11, 4, 5 then we expect to return Thanksgiving day 11/28/2013 or the 4th Thursday in November.
'This returns the "Day" element.
Debug.Print (8 - Weekday(DateSerial(lngYear, lngMonth, 1), (lngDayOfWeek + 1) Mod 8)) + ((lngNumber - 1) * 7)
'Or "28" in the case of our 2013, 11, 4, 5 example condition.
Debug.Print (8 - Weekday(DateSerial(2013, 11, 1), (5 + 1) Mod 8)) + ((4 - 1) * 7)
'This returns the Weekday for the first day of the month passed.
Debug.Print Weekday(DateSerial(lngYear, lngMonth, 1))
'(This is the part that I don't really understand myself). Now offset that by defining different first day of week.
Debug.Print Weekday(DateSerial(lngYear, lngMonth, 1), (lngDayOfWeek + 1) Mod 8)
'Or first day of week is Friday in our example.
Debug.Print Weekday(DateSerial(2013, 11, 1), (5 + 1) Mod 8)
'This returns the date of the first occurance of lngDayofWeek in the defined month.
Debug.Print (8 - Weekday(DateSerial(lngYear, lngMonth, 1), (lngDayOfWeek + 1) Mod 8))
'Or
Debug.Print (8 - Weekday(DateSerial(2013, 11, 1), (5 + 1) Mod 8))
'So now in our example, we know that the first Thursday in Novemeber falls on the 7th.
'We want the fourth Thursday so how many days do we need to add to the 7th?
Debug.Print (lngNumber - 1) * 7
'Or
Debug.Print (4 - 1) * 7
fcn_NthWeekday = DateSerial(lngYear, lngMonth, (8 - Weekday(DateSerial(lngYear, lngMonth, 1), (lngDayOfWeek + 1) Mod 8)) + ((lngNumber - 1) * 7))
lbl_Exit:
Exit Function
End Function


You should have surmised that someone much smarter than me wrote that function. Ok, this is likely how I would have done it as I understand this process much better:

Public Function fcn_NthWeekday(lngYear As Long, lngMonth As Long, lngNumber As Long, lngDayOfWeek As Long) As Date
Dim lngIndex As Long
'Takes as arguments 1) lngYear = A year 2) lngMonth = A month 3) lngNumber = The Nth (e.g., 1st, 2nd, 3rd lngDayOfWeek) _
lngDayOfWeek = A constant (e.g., 5 or vbThursday)

'So if we pass 2013, 11, 4, 5 then we expect to return Thanksgiving day 11/28/2013 or the 4th Thursday in November.

lngIndex = 0
'Find the date of the first occurence of lngDayOfWeek.
Do
lngIndex = lngIndex + 1
Loop Until Weekday(DateSerial(lngYear, lngMonth, lngIndex)) = lngDayOfWeek
'So in our example lngIndex will be "7" as the first Thursday in November 2013 falls on the 7th.

'To those "7" days, we want to add three more week or (lngNumber - 1) * 7.
fcn_NthWeekday = DateSerial(lngYear, lngMonth, lngIndex + (lngNumber - 1) * 7)
lbl_Exit:
Exit Function
End Function