Public Function Zeller(MyDate As String, Optional DateFormat As String = "DD/MM/YYYY", Optional TraceIt As Boolean = False) As String

'       This function will determine the day name of a passed date
           
'       The date can be in DD/MM/YYYY format (the default), MM/DD/YYYY, YYYY/MM/DD or YYYY/DD/MM formats

'       To use SAP format dates (YYYYMMDD) use "SAP" as a the date format

Dim DayArray() As Variant
Dim zYear As Integer
Dim zYear1 As Integer
Dim zMonth As Integer
Dim zMonthWork As Integer
Dim zDay As Integer
Dim WorkArray() As String
Dim DayIndex As Integer
Dim Cal As Boolean

'       Build the array of days of the week

DayArray = Array("Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday")
If UCase(DateFormat) = "SAP" Then
    If Len(MyDate) <> 8 Then
        GoTo Failout
    End If
    MyDate = Right(MyDate, 2) & "/" & Mid(MyDate, 5, 2) & "/" & Left(MyDate, 4)
    DateFormat = "DD/MM/YYYY"
End If
If Not IsDate(MyDate) Then
Failout:
    If TraceIt = True Then
    MsgBox "The passed date " & MyDate & " is not a valid date", vbCritical, "Message from Zeller Function"
    End If
SetInvalid:
    Zeller = "Invalid"
    Exit Function
End If
WorkArray = Split(MyDate, "/")

Select Case UCase(Left(DateFormat, 2))
    Case "DD"
        If WorkArray(0) > 31 Then GoTo Failout
        zDay = WorkArray(0)
        If WorkArray(1) > 12 Then GoTo Failout
        zMonth = WorkArray(1)
    Case "MM"
        If WorkArray(0) > 12 Then GoTo Failout
        zMonth = WorkArray(0)
        If WorkArray(1) > 31 Then GoTo Failout
        zDay = WorkArray(1)
    Case "YY"
        zYear = WorkArray(0)
        If UCase(Right(DateFormat, 2)) = "DD" Then
            zDay = WorkArray(2)
            zMonth = WorkArray(1)
        Else
            If UCase(Right(DateFormat, 2)) = "MM" Then
                zDay = WorkArray(1)
                zMonth = WorkArray(2)
            Else
                If TraceIt = True Then
                MsgBox "DateFormat (" & DateFormat & " ) not recognised", vbCritical, "Message from Zeller Function"
                End If
                GoTo SetInvalid
            End If
        End If
      
    Case Else
        If TraceIt = True Then
        MsgBox "DateFormat (" & DateFormat & " ) not recognised", vbCritical, "Message from Zeller Function"
        End If
        GoTo SetInvalid
End Select
Select Case UCase(Right(DateFormat, 2))
    Case "DD"
        If WorkArray(2) > 31 Then GoTo Failout
        zDay = WorkArray(2)
        If WorkArray(1) > 12 Then GoTo Failout
        zMonth = WorkArray(1)
    Case "MM"
        If WorkArray(2) > 12 Then GoTo Failout
        zMonth = WorkArray(2)
        If WorkArray(1) > 31 Then GoTo Failout
        zDay = WorkArray(1)
    Case "YY"
        zYear = WorkArray(2)
        If UCase(Left(DateFormat, 2)) = "DD" Then
            zDay = WorkArray(0)
            zMonth = WorkArray(1)
        Else
            If UCase(Left(DateFormat, 2)) = "MM" Then
                zDay = WorkArray(1)
                zMonth = WorkArray(0)
            Else
                If TraceIt = True Then
                MsgBox "DateFormat (" & DateFormat & " ) not recognised", vbCritical, "Message from Zeller Function"
                End If
                GoTo SetInvalid
            End If
        End If
      
    Case Else
        If TraceIt = True Then
        MsgBox "DateFormat (" & DateFormat & " ) not recognised", vbCritical, "Message from Zeller Function"
        GoTo SetInvalid
        End If
End Select

'       Now we have the years and months etc set lets recheck the date

If Not IsDate(zDay & "/" & zMonth & "/" & zYear) Then GoTo Failout

'       Right we are good to go. We could just use the Excel vbWeekday function for dates after 1900 but we won't

Cal = True
zMonthWork = zMonth
zYear1 = zYear

If zMonth < 3 Then
    zMonthWork = zMonth + 12
    zYear1 = zYear - 1
End If

'       Calculate Zeller's Congruence

zMonthWork = (zDay + (((zMonthWork + 1) * 13) \ 5) + zYear1 + (zYear1 \ 4) - (zYear1 \ 100) + (zYear1 \ 400))

' Templars 13/10/1307 should be a Friday

If zYear < 1752 Then
    zMonthWork = zMonth
    zMonthWork = (zDay + (((zMonthWork + 1) * 13) \ 5) + zYear1 + (zYear1 \ 4) + 5)
End If
If zYear = 1752 Then
    If zMonth = 3 Then
        If zDay < 24 Then
            zMonthWork = zMonth
            zMonthWork = (zDay + (((zMonthWork + 1) * 13) \ 5) + zYear1 + (zYear1 \ 4) - (zYear1 \ 100) + (zYear1 \ 400))
        End If
    End If
End If
zMonthWork = zMonthWork Mod 7
Zeller = DayArray(zMonthWork)
End Function