Hijri Gregorian Date Conversion

[wolflow]

Found very useful code to convert Hiiri to Gregorian dates on http://www.islamicsoftware.org/
I found another function which calculates date of Eid Al Adha as a Hijri date.

The two functions aside work fine, however if I try to use the code to convert the Hijri date of Eid Al Adha to a Gregorian date it causes Excel to crash.

=greg_date(12/10/1436) works fine
=Eid_Al_Adha_Hijri(2015) works fine
=gregdate(Eid_Al_Adha_Hijri(2015)) causes Excel to crash

My Excel knowledge is insufficient to solve this issue, your help would be highly appreciated.

Option Base 1

' Source: http://www.islamicsoftware.org/hijridates/hijridates.html

Function isleap As Boolean
isleap = ((n Mod 4 = 0) And (n Mod 400 <> 0))
End Function

Function isLeapH As Boolean
isLeapH = (n = 3 Or n = 5 Or n = 8)
End Function

Function FindYear
'Returns number of whole years elapsed in current cycle
YearFinder = Array(354, 708, 1063, 1417, 1772, 2126, 2480, 2835)
For i = 1 To 8
If n <= YearFinder(i) Then
FindYear = i
Exit For
End If
Next i
End Function

Function FindMonth(n, leap)
'Returns number of whole months elapsed in current year
MonthFinderL = Array(30, 59, 89, 118, 148, 177, 207, 236, 266, 296, 325, 355)
MonthFinder = Array(29, 59, 88, 118, 147, 177, 206, 236, 265, 295, 324, 354)
'would't let me make these two public!
If leap Then
For i = 1 To 12
If n <= MonthFinderL(i) Then
FindMonth = i
Exit For
End If
Next i
Else
For i = 1 To 12
If n <= MonthFinder(i) Then
FindMonth = i
Exit For
End If
Next i
End If
End Function

Function HijriDate(dat As Long) As String
Hstart = 1324
Cstart = CLng(#2/24/1906#) 'Corresponds to 1 Muharram 1324
DCycle = 2835
YearFinder = Array(354, 708, 1063, 1417, 1772, 2126, 2480, 2835)
MonthFinderL = Array(30, 59, 89, 118, 148, 177, 207, 236, 266, 296, 325, 355)
MonthFinder = Array(29, 59, 88, 118, 147, 177, 206, 236, 265, 295, 324, 354)
elp = dat - Cstart
ncycles = elp \ DCycle 'Number of elapsed cycles
ndays_thiscycle = elp Mod DCycle
If ndays_thiscycle = 0 Then 'Last day of the cycle
hyr = Hstart + ncycles * 8
HijriDate = "12/30/" & hyr
Exit Function
End If
nyear = FindYear(ndays_thiscycle) 'This year in current cycle
leapH = isLeapH(nyear)
If nyear = 1 Then
ndays_thisyear = ndays_thiscycle
Else
ndays_thisyear = ndays_thiscycle - YearFinder(nyear - 1)
End If
months = FindMonth(ndays_thisyear, leapH) 'This month in current year
If months = 1 Then
daysinmonths = 0 'Days in preceding months
ElseIf leapH Then
daysinmonths = MonthFinderL(months - 1)
Else
daysinmonths = MonthFinder(months - 1)
End If
nDays = ndays_thisyear - daysinmonths
hyr = Hstart + ncycles * 8 + nyear - 1
Debug.Print dat, ncycles, ndays_thiscycle
Debug.Print nyear, leapH
Debug.Print ndays_thisyear, months, daysinmonths
HijriDate = months & "/" & nDays & "/" & hyr
End Function
Sub convert_month()
Dim a(31)
last_day = Array(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
s = InputBox("enter month and year in the form mm/yyyy:")
y = CInt(Right(s, 4))
m = CInt(Left(s, 2))
d = DateSerial(y, m, 1)
L = last_day(m)
For i = 1 To L
a(i) = HijriDate(d + i - 1)
Debug.Print i, a(i)
Next i
End Sub
Function greg_date(hdat As String) As Date
YearFinder = Array(354, 708, 1063, 1417, 1772, 2126, 2480, 2835)
MonthFinderL = Array(30, 59, 89, 118, 148, 177, 207, 236, 266, 296, 325, 355)
MonthFinder = Array(29, 59, 88, 118, 147, 177, 206, 236, 265, 295, 324, 354)
Cstart = CLng(#2/24/1906#) 'Corresponds to 1 Muharram 1324
Hstart = 1324
DCycle = 2835
'parse s to produce hmonth, hday, hyear
i = InStr(hdat, "/")
hmonth = CInt(Left(hdat, i - 1))
j = InStr(i + 1, hdat, "/")
hday = CInt(Mid(hdat, i + 1, j - i - 1))
hyear = CInt(Right(hdat, Len(hdat) - j))
elapsed_years = hyear - Hstart
ncycles = elapsed_years \ 8
nyear = elapsed_years Mod 8
If nyear = 0 Then
days_thiscycle = 0
Else
days_thiscycle = YearFinder(nyear)
End If
leap = isLeapH(nyear)
If hmonth = 1 Then
days_thisyear = hday
Else
If leap Then
days_thisyear = MonthFinderL(hmonth - 1) + hday
Else
days_thisyear = MonthFinder(hmonth - 1) + hday
End If
End If
days_thiscycle = days_thiscycle + days_thisyear
greg_date = Cstart - 1 + ncycles * DCycle + days_thiscycle
End Function

Public Function Eid_Al_Adha_Hijri(GregYear As Integer) As String
' http://en.wikipedia.org/wiki/Eid_al-Adha
' 10th day of 12th month -> SEE LAST LINE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Need this function to convert other Hijri dates as well......
' So need to be able to change Hijri month & day

' Feast of the Sacrifice
' Latter of two Eids

' 1 = Muharram
' 2 = Safar"
' 3 = Rabi’ al-awwal(Rabi’ I)
' 4 = Rabi’ al-thani(Rabi’ II)
' 5 = Jumada al-awwal(Jumada I)
' 6 = Jumada al-thani(Jumada II)
' 7 = Rajab
' 8 = Sha'ban
' 9 = Ramadan
' 10 = Shawwal
' 11 = Dhu al-Qi'dah
' 12 = Dhu al-Hijjah

Hstart = 1324
Cstart = CLng(#2/24/1906#) 'Corresponds to 1 Muharram 1324
DCycle = 2835
YearFinder = Array(354, 708, 1063, 1417, 1772, 2126, 2480, 2835)
MonthFinderL = Array(30, 59, 89, 118, 148, 177, 207, 236, 266, 296, 325, 355)
MonthFinder = Array(29, 59, 88, 118, 147, 177, 206, 236, 265, 295, 324, 354)
elp = DateSerial(GregYear, 1, 1) - Cstart
ncycles = elp \ DCycle 'Number of elapsed cycles
ndays_thiscycle = elp Mod DCycle
If ndays_thiscycle = 0 Then 'Last day of the cycle
hyr = Hstart + ncycles * 8
Eid_Al_Adha_Hijri = "12/30/" & hyr
Exit Function
End If
nyear = FindYear(ndays_thiscycle) 'This year in current cycle
leapH = isLeapH(nyear)
If nyear = 1 Then
ndays_thisyear = ndays_thiscycle
Else
ndays_thisyear = ndays_thiscycle - YearFinder(nyear - 1)
End If
months = FindMonth(ndays_thisyear, leapH) 'This month in current year
If months = 1 Then
daysinmonths = 0 'Days in preceding months
ElseIf leapH Then
daysinmonths = MonthFinderL(months - 1)
Else
daysinmonths = MonthFinder(months - 1)
End If
nDays = ndays_thisyear - daysinmonths + 1
hyr = Hstart + ncycles * 8 + nyear - 1
Debug.Print dat, ncycles, ndays_thiscycle
Debug.Print nyear, leapH
Debug.Print ndays_thisyear, months, daysinmonths
Eid_Al_Adha_Hijri = "12/10/" & hyr

End Function

 

[mohd radhi]

Please use the version below and tell me what the information message box says:

Function G2H$(dtGregDate As Date)
Dim m, v, s$
m = Array("Muharram", "Safar", "Rabiul Awwal", "Rabiul Akhir", "Jamadil Awwal", "Jamadil Akhir", _
"Rajab", "Syaaban", "Ramadhan", "Syawwal", "Dzul Qa'dah", "Dzul Hijjah")
VBA.Calendar = vbCalHijri
v = Split(dtGregDate, "/")
MsgBox "Date= " & dtGregDate & vbLf & "Ubound= " & UBound(v), 64, "Information"
Select Case Val(v(0))
    Case 1: s = "st"
    Case 2: s = "nd"
    Case 3: s = "rd"
    Case Else: s = "th"
End Select
G2H = v(0) & s & " of " & m(Val(v(1)) - 1) & " " & v(2)
VBA.Calendar = vbCalGreg
End Function

[COLOR=#574123][FONT=Segoe UI Light][SIZE=3]Sub Hj()
MsgBox G2H("29/05/1984")
End Sub
[/SIZE][/FONT][/COLOR]

Sorry, i'm new that this repeatative reply occured. Actually i tried to upload screenshot of the result but success.

 

[Worf]

This one should work:

Function G2H$(dtGregDate As Date)
Dim m, v, s$, sep$
'sep = "/"   ' this is my date separator
sep = "-"
m = Array("Muharram", "Safar", "Rabiul Awwal", "Rabiul Akhir", "Jamadil Awwal", "Jamadil Akhir", _
"Rajab", "Syaaban", "Ramadhan", "Syawwal", "Dzul Qa'dah", "Dzul Hijjah")
VBA.Calendar = vbCalHijri
v = Split(dtGregDate, sep)
Select Case Val(v(0))
    Case 1: s = "st"
    Case 2: s = "nd"
    Case 3: s = "rd"
    Case Else: s = "th"
End Select
G2H = v(0) & s & " of " & m(Val(v(1)) - 1) & " " & v(2)
VBA.Calendar = vbCalGreg
End Function


Sub Hj()
MsgBox G2H("03/05/1985")
End Sub

 

[mohd radhi]

This one should work:

Function G2H$(dtGregDate As Date)
Dim m, v, s$, sep$
'sep = "/"   ' this is my date separator
sep = "-"
m = Array("Muharram", "Safar", "Rabiul Awwal", "Rabiul Akhir", "Jamadil Awwal", "Jamadil Akhir", _
"Rajab", "Syaaban", "Ramadhan", "Syawwal", "Dzul Qa'dah", "Dzul Hijjah")
VBA.Calendar = vbCalHijri
v = Split(dtGregDate, sep)
Select Case Val(v(0))
    Case 1: s = "st"
    Case 2: s = "nd"
    Case 3: s = "rd"
    Case Else: s = "th"
End Select
G2H = v(0) & s & " of " & m(Val(v(1)) - 1) & " " & v(2)
VBA.Calendar = vbCalGreg
End Function


Sub Hj()
MsgBox G2H("03/05/1985")
End Sub

Many thanks again Mr Worf , but it's still pointing to the same error :

Run-time error '9' :
Subscript out of range
G2H = v(0) & s & " of " & m(Val(v(1)) - 1) & " " & v(2)


Sorry that i couldnt figure it out myself, tried to modify your above codes but still with no success.
I'm using excel 2016 windows 64bit, do you think this is the cause why it doesnt work?

 

[Worf]

I need you to perform the following test:

• Type a date on cell A1 and the date separator on cell B1, whether it is a “/” or a “-“.
• Run the code below and report the results.
• See image for reference.

Sub test()
Dim d As Date, sep$, v
d = [a1]
sep = [b1]
v = Split(CStr(d), sep)
MsgBox "Date is " & d & vbLf & "Ubound= " & UBound(v)
End Sub

 

[mohd radhi]

I need you to perform the following test:

• Type a date on cell A1 and the date separator on cell B1, whether it is a “/” or a “-“.
• Run the code below and report the results.
• See image for reference.

Sub test()
Dim d As Date, sep$, v
d = [a1]
sep = [b1]
v = Split(CStr(d), sep)
MsgBox "Date is " & d & vbLf & "Ubound= " & UBound(v)
End Sub

it appeared as follows :

 

[Worf]

Please perform one last test; type a date at cell A1, run the code below and report the results.

Sub Another_test()
Dim ms$, i%, s$
ms = [a1]
If IsDate(ms) Then MsgBox "A1 has a date."
s = ""
For i = 1 To Len(ms)
    s = s & Asc(Mid$(ms, i, 1)) & vbLf
Next
MsgBox s, 64, "Character codes"
End Sub

 

[Worf]

Make sure this code uses your date separator, not mine:

Function G2Hi$(dtGregDate As Date)
Dim m, v, s$, sep$
sep = "/"   ' this is my date separator
'  sep = "-"    ' your separator
m = Array("Muharram", "Safar", "Rabiul Awwal", "Rabiul Akhir", "Jamadil Awwal", "Jamadil Akhir", _
"Rajab", "Syaaban", "Ramadhan", "Syawwal", "Dzul Qa'dah", "Dzul Hijjah")
VBA.Calendar = vbCalHijri
v = Split(dtGregDate, sep)
Select Case Val(v(0))
    Case 1: s = "st"
    Case 2: s = "nd"
    Case 3: s = "rd"
    Case Else: s = "th"
End Select
G2Hi = v(0) & s & " of " & m(Month(dtGregDate) - 1) & " " & v(2)
VBA.Calendar = vbCalGreg
End Function[/FONT][/COLOR]

[COLOR=#574123][FONT=Lucida Bright]Sub Hj()
MsgBox G2Hi([k42])      ' cell K42
End Sub
[/FONT][/COLOR]

 

[mohd radhi]

Make sure this code uses your date separator, not mine:

Function G2Hi$(dtGregDate As Date)
Dim m, v, s$, sep$
sep = "/"   ' this is my date separator
'  sep = "-"    ' your separator
m = Array("Muharram", "Safar", "Rabiul Awwal", "Rabiul Akhir", "Jamadil Awwal", "Jamadil Akhir", _
"Rajab", "Syaaban", "Ramadhan", "Syawwal", "Dzul Qa'dah", "Dzul Hijjah")
VBA.Calendar = vbCalHijri
v = Split(dtGregDate, sep)
Select Case Val(v(0))
    Case 1: s = "st"
    Case 2: s = "nd"
    Case 3: s = "rd"
    Case Else: s = "th"
End Select
G2Hi = v(0) & s & " of " & m(Month(dtGregDate) - 1) & " " & v(2)
VBA.Calendar = vbCalGreg
End Function

[COLOR=#574123][FONT=Lucida Bright]Sub Hj()
MsgBox G2Hi([k42])      ' cell K42
End Sub
[/FONT][/COLOR]

Many thanks Mr Worf!

This finally has come to work.

Sorry that you did mention about date separator in your earlier codes but thats my bad i didnt get it.

Thank you so much.