VB6 - A function for obtaining the Day of the Week given the Date

[Senacharim]

Alright, actually it's two functions; DayOfTheWeek_S and DayOfTheWeek_I.
DayOfTheWeek_S returns a string value with the day of the week, and DayOfTheWeek_I returns an integer value (0 to 6) of the same.

Perfect for a module....

Option Explicit

Dim intYr As Integer
Dim intMo As Integer
Dim intDay As Integer

Public Function DayOfTheWeek_S(ByVal TheDate As Date) As String
 Select Case DayOfTheWeek_I(TheDate)
  Case 0
   DayOfTheWeek_S = "Sunday"
  Case 1
   DayOfTheWeek_S = "Monday"
  Case 2
   DayOfTheWeek_S = "Tuesday"
  Case 3
   DayOfTheWeek_S = "Wednesday"
  Case 4
   DayOfTheWeek_S = "Thursday"
  Case 5
   DayOfTheWeek_S = "Friday"
  Case 6
   DayOfTheWeek_S = "Saturday"
  Case Else
   DayOfTheWeek_S = "HOLY ****!"
 End Select
End Function

Public Function DayOfTheWeek_I(TheDate As Date) As Integer
 intYr = Year(TheDate)
 intMo = Month(TheDate)
 intDay = Day(TheDate)

 'Debug.Print intYr; "intYr"
 'Debug.Print intMo; "intMo"
 'Debug.Print intDay; "intDay"
' W = D + Y + Year + M + C
' |   |   |     |    |   ^Century Offset Number (see Century_Offset Function)
' |   |   |     |    Month Offset Number (see MonthOffset Function)
' |   |   |     Present Year sans Century (i.e. if it's 2008, this number would be "8")
' |   |  'YearOffset...
' |   Day of the Month (i.e. if the Date is Janueary 1st, this number would be a "1")
' Day of the Week! (More or less;)
                          
 DayOfTheWeek_I = intDay + YearOffset + IntYear + MonthOffset + CenturyOffset
 DayOfTheWeek_I = DayOfTheWeek_I Mod 7
End Function

Private Function MonthOffset() As Integer
 Select Case intMo
  Case 1
   MonthOffset = 0
   If LeapYear = True Then MonthOffset = 6
  Case 2
   MonthOffset = 3
   If LeapYear = True Then MonthOffset = MonthOffset - 1
  Case 3
   MonthOffset = 3
  Case 4
   MonthOffset = 6
  Case 5
   MonthOffset = 1
  Case 6
   MonthOffset = 4
  Case 7
   MonthOffset = 6
  Case 8
   MonthOffset = 2
  Case 9
   MonthOffset = 5
  Case 10
   MonthOffset = 0
  Case 11
   MonthOffset = 3
  Case 12
   MonthOffset = 5
 End Select
 'Debug.Print MonthOffset; "MonthOffset"
End Function

Private Function LeapYear() As Boolean
 If IntYear = 0 Then 'Century!
  If Century / 400 = Century \ 400 Then LeapYear = True
  If Century / 4000 = Century \ 4000 Then LeapYear = False
 Else 'not round century...
  If (Century Mod 4) = 0 Then LeapYear = True
 End If
 'Debug.Print LeapYear; "LeapYear"
End Function

Private Function IntYear() As Integer
 IntYear = intYr - (IntCentury * 100)
 'Debug.Print IntYear; "IntYear"
End Function

Private Function IntCentury() As Integer
 IntCentury = intYr \ 100
 'Debug.Print IntCentury; "IntCentury"
End Function

Private Function CenturyOffset() As Integer
 CenturyOffset = 2 * (3 - (IntCentury Mod 4))
 'Debug.Print CenturyOffset; "CenturyOffset"
End Function

Private Function YearOffset() As Integer
 YearOffset = IntYear \ 4
 'Debug.Print YearOffset; "YearOffset"
End Function

I'm sure this could be optimized, I only needed it to work.
I've gotten alot from this forum, glad nobody's posted this yet so I can give a little back.

[si_the_geek]

Thanks for sharing

That can actually be simplified quite a bit by making use of the Format function, which provides lots of functionality for converting Dates etc:

Public Function DayOfTheWeek_S(ByVal TheDate As Date) As String
  DayOfTheWeek_S = Format(TheDate, "dddd")
End Function

Public Function DayOfTheWeek_I(TheDate As Date) As Integer
  DayOfTheWeek_I = Format(TheDate, "w") - 1
End Function

(I added the -1 because the format function returns "1 for Sunday through 7 for Saturday", which is 1 higher than you wanted).

[Hack]

I echo si_the_geek's comments. Thanks for sharing.

The leap year testing could also be optimized a bit by using the DateSerial function

Private Function IsThisALeapYear(ByVal intYear As Integer) As Boolean
     IsThisALeapYear = (29 = Day(DateSerial(intYear, 2, 29)))
End Function

[Senacharim]

Ah, gone and re-coded the wheel, have I?

Well, live and learn. Thanks for the instructional words of wisdom.

[bluemoon4ever]

Bit late in the day but this way is even faster by using the Weekday function

Usage

Dim Myday as integer
Dim MyDayS as String
MyDay = Weekday(Date) 'returns a number 1 .. 7 (Sunday ... Saturday)

Then just do a few if's and Else's to convert the number to a day string ... such as

If myday = 1 then
     MyDayS = "Sunday"
elseif Myday = 2 then
     MyDayS = "Monday"
etc.
etc.
Else
    MydayS = "Saturday"
End If

Alternately you can use the Format Function to grab the day from the current, or any given date

Dim MyStr As String
MyStr = Format(Date, "ddd")   ' Returns Day name ie. Mon, Tue, Wed etc