VB: This code automatically assigns the correct expiry string based
on the present date. Primarily for Index Futures products that roll
quarterly. Subscribes to the second Thursday rule.
Now in the files section:
Project requires:
Form1 form
Moudle1 module
Label1, Label2 Label3 labels
Command1 Command button
'Code Starts
'FormCode
Option Explicit
Private Sub Command1_Click()
Label1 = fxExpiry
Label3 = "This Contract Rolls On: " & fxRollOverDate _
& vbCrLf _
& fxDaysRemaining & " Days Left"
End Sub
Private Sub Form_Load()
Label2.Caption = _
"INDEX CONTRACT EXPIRY FINDER" & vbCrLf & vbCrLf & _
"This code will properley return the expiry based " & _
"on the present date." & vbCrLf & vbCrLf & _
"It confroms to the standard that contract trading" & _
" rolls over on the second thursday of the month of
expiration." & _
vbCrLf & vbCrLf & "Todays Date: " & Date
Label1 = fxExpiry
Label3 = "This Contract Rolls On: " & fxRollOverDate _
& vbCrLf _
& fxDaysRemaining & " Days Left"
End Sub
'Module Code
Option Explicit
Private m_qtr As Integer
Private m_ContractDate As Date
Function fxExpiry() As String
Dim firstVBday As Integer
Dim StartDate As Date
m_qtr = DatePart("q", Date)
Select Case m_qtr
Case 1
StartDate = "3/1/" & Year(Now)
firstVBday = Weekday(StartDate)
m_ContractDate = fxContractDate(StartDate, firstVBday)
Case 2
StartDate = "6/1/" & Year(Now)
firstVBday = Weekday(StartDate)
m_ContractDate = fxContractDate(StartDate, firstVBday)
Case 3
StartDate = "9/1/" & Year(Now)
firstVBday = Weekday(StartDate)
m_ContractDate = fxContractDate(StartDate, firstVBday)
Case 4
StartDate = "12/1/" & Year(Now)
firstVBday = Weekday(StartDate)
m_ContractDate = fxContractDate(StartDate, firstVBday)
End Select
fxExpiry = fxNewString()
End Function
Function fxRollOverDate() As String
Dim tempDate As Date
'Call fxExpiry
Select Case m_qtr
Case 4
If Date > m_ContractDate Then
tempDate = fxContractDate("3/1/" & Year(Now) + 1, _
Weekday("3/1/" & Year(Now) + 1))
fxRollOverDate = tempDate
Else
fxRollOverDate = m_ContractDate
End If
Case Else
fxRollOverDate = m_ContractDate
End Select
End Function
Function fxDaysRemaining()
Dim tempDate As Date
'Call fxExpiry
Select Case m_qtr
Case 4
If Date > m_ContractDate Then
tempDate = fxContractDate("3/1/" & Year(Now) + 1, _
Weekday("3/1/" & Year(Now) + 1))
fxDaysRemaining = tempDate - Date
Else
fxDaysRemaining = m_ContractDate - Date
End If
Case Else
fxDaysRemaining = m_ContractDate - Date
End Select
End Function
Private Function fxContractDate(ByVal dStart As Date, ByVal iDay As
Integer) As Date
If iDay = 5 Then
fxContractDate = dStart + 7
Else
Do
dStart = dStart + 1
Loop Until Weekday(dStart) = 5
fxContractDate = dStart + 7
End If
End Function
Private Function fxNewString() As String
Dim strYear As String
Dim strMonth As String
Dim arrMonth(1 To 4)
arrMonth(1) = "03": arrMonth(2) = "06"
arrMonth(3) = "09": arrMonth(4) = "12"
If Date < m_ContractDate Then
strMonth = arrMonth(m_qtr)
strYear = Year(Date)
Else
If Date = m_ContractDate Then
MsgBox "Contract Rolls Today!" _
& vbCrLf _
& " Liquidity At Issue" _
& vbCrLf _
& "Next Contract Selected"
End If
If m_qtr < 4 Then
strMonth = arrMonth(m_qtr + 1)
strYear = Year(Date)
Else
strMonth = arrMonth(1)
strYear = Year(Date) + 1
End If
End If
fxNewString = strYear & strMonth
End Function
