|
A Solution to the May 2001 Puzzler: How do I find the Third Friday of the Month.
This is a specialized solution in that the 3rd Friday is Hard
Coded.
Function smrNextThirdFriday(datX As Date) As Date
'Given an XL serial number date (datX),
'return the date serial number of the next Third Friday
' which could be in the next month.
'This is useful to calculate the date of expiration of Stock Options.
'if datX is a third Friday, it will return that same date.
'
'Stephen Rasey 010429
'
Dim datThisMonth15 As Date
Dim datNextMonth15 As Date
Dim iYear As Integer
Dim iMonth As Integer
Dim iWeekday1 As Integer
Dim iMoreDays As Integer
On Error GoTo Err1
iYear = Year(datX)
iMonth = Month(datX)
'Get the Date Serial of the 15th of the datX month.
'this is the 1st date the third friday could be.
datThisMonth15 = DateSerial(iYear, iMonth, 15)
iWeekday1 = WeekDay(datThisMonth15) 'Sunday = 1, Fri = 6, Sat = 7
iMoreDays = 6 - iWeekday1
'it is possible that the 15th is Saturday (day 7).
If iMoreDays < 0 Then iMoreDays = iMoreDays + 7
'this is a implicit coercion, but should be ok.
smrNextThirdFriday = datThisMonth15 + iMoreDays
'is the Third Friday for this month already past?
If smrNextThirdFriday < datX Then
'note, a 13th month is possible, but it will work properly.
datNextMonth15 = DateSerial(iYear, iMonth + 1, 15)
iWeekday1 = WeekDay(datNextMonth15)
iMoreDays = 6 - iWeekday1
'it is possible that the 15th is Saturday (day 7).
If iMoreDays < 0 Then iMoreDays = iMoreDays + 7
'this is a implicit coersion, but should be ok.
smrNextThirdFriday = datNextMonth15 + iMoreDays
End If
Exit Function
Err1:
'unanticipated error.
'return -1
smrNextThirdFriday = -1
End Function
|
For questions or comments concerning content on this
website: Stephen Rasey |