Option Explicit
Function CopticDate(WkDate As Date) As String
Const YDiff = 284
Dim DateList As Object
Set DateList = CreateObject("System.Collections.Sortedlist")
Dim T, TT
Dim I As Integer, II As Integer
Dim WkY As Integer
Dim WkM As String
Dim WkD As Integer
Dim AAA, BBB, CCC, DDD
With Sheets("Data")
For I = 1 To 13
T = Split(.Cells(I + 1, 3), "/")
DateList.Add DateSerial(Year(WkDate), T(1), T(0)) * 1, .Cells(I + 1, 4)
Next I
End With
WkY = Year(WkDate) - YDiff
With DateList
TT = WkDate * 1
If (TT >= .GetKey(.Count - 1)) Then
WkM = .GetByIndex(0)
WkD = TT - .GetKey(.Count - 1) + 1
Else
If (TT <= .GetKey(0)) Then
WkM = .GetByIndex(.Count - 1)
II = TT - DateSerial(Year(WkDate), 1, 1) ' FIRST day of the year = 101
WkD = DateSerial(Year(WkDate), 12, 31) - .GetKey(.Count - 1) + II ' LAST day of the year = 1231
Else
For I = 0 To 12
AAA = .GetKey(I)
BBB = .GetKey(I + 1)
If ((TT > .GetKey(I)) And (TT <= .GetKey(I + 1))) Then
WkM = .GetByIndex(I + 1)
WkD = TT - .GetKey(I)
Exit For
End If
Next I
End If
End If
End With
CopticDate = WkD & "/ " & WkM & "/ " & WkY
End Function