UF_smrNext3rdFriday
Home Up Past Meetings Notes Tips Directory Links of Interest Site Map FAQs

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.    
See smrNextNthWeekday() for a more generalized function.

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
Design of this site by Cheryl D. Wise
Copyright © 2000-2004 by WiserWays. All rights reserved.
Revised: 2005-07-10 01:08 .