Attribute VB_Name = "DayOfWeekFinder"
Option Explicit
' Module: DayOfWeekFinder.bas contains a simple implementation of the
' Doomsday Algorithm published by John H. Conway in 1973.
'
' Copyright 2013 by Charles Thayer
'
' Released under Creative Commons Attribution-ShareAlike 3.0 Unported
' http://creativecommons.org/licenses/by-sa/3.0/
Function dayOfWeek(dDate As Date) As Integer
Dim iYear As Integer, iCentury As Integer, iMonth As Integer
Dim iDay As Integer, iOffset As Integer, iMod As Integer
Dim iLeap As Integer, iLeapExcept As Integer, monthPos As Integer
' Parse the Date and find the Doomsday Century Anchor
iYear = Year(dDate)
iMonth = Month(dDate)
iDay = Day(dDate)
iCentury = Int(iYear / 100)
iCentury = (16 - 2 * (iCentury Mod 4)) Mod 7
' Check leap year exception:
' - If Century Anchor is Tuesday, it's a leap year.
If iCentury = 2 Then iLeapExcept = 1 Else iLeapExcept = 0
' Calculate Doomsday number for year within century
iYear = iYear Mod 100
iMod = iYear Mod 12
iOffset = Int(iYear / 12) + iMod + Int(iMod / 4) + iCentury
' Fill in monthPos offset:
' a) 4/4, 6/6, 8/8, 10/10, 12/12
' b) "I work my 9 to 5 job at 7-11."
' c) The 0th day of March is Doomsday. March backward a few weeks to
' get (February 7 or 8) and (January 3 or 4).
' Case 1: Month > 3 means no Leap year adjustment
If iMonth > 3 Then
If iMonth Mod 2 = 0 Then
monthPos = iMonth
ElseIf iMonth Mod 4 = 1 Then
' May and September (9/5, 5/9)
monthPos = 14 - iMonth
Else
' July and November (7/11, 11/7)
monthPos = 18 - iMonth
End If
Else
If iMonth = 1 Then
monthPos = 3
Else
' Case 2: February and March both start at zero
monthPos = 0
End If
' Case 3: January and February need leap year adjustment
If iMonth < 3 Then
' Is this a leap year?
' 0: Basic presumption: No
iLeap = 0
' 1: If we're on a 4N year, Yes
If iYear Mod 4 = 0 Then iLeap = 1
' 2: Century boundary
If iYear = 0 Then iLeap = iLeapExcept
monthPos = monthPos + iLeap
End If
End If
' Make adjustments from Doomsday setting for the month
dayOfWeek = (35 + iDay - monthPos + iOffset) Mod 7
Exit Function
End Function
Function Doomsday(iCent As Integer) As Integer
' Century number is 2 (Tuesday) for 2000, 0 for 1700,
' 5 for 1800, 3 for 1900
Doomsday = (16 - 2 * (iCent Mod 4)) Mod 7
End Function
Function bIsLeapYear(yr As Integer) As Boolean
' Presumption is "not a leap year"
bIsLeapYear = False
If yr Mod 4 <> 0 Then
Exit Function
End If
' From here onward, the year is divisible by 4
bIsLeapYear = True
If yr Mod 100 <> 0 Then
Exit Function
End If
' From here onward, the year is divisible by 100
yr = yr / 100
' If xx00 is divisible by 400, it is a leap year. Otherwise, it isn't.
If yr Mod 4 <> 0 Then bIsLeapYear = False
Exit Function
End Function