Hijri Gregorian Date Conversion

wolflow

New Member
Joined
Apr 23, 2015
Messages
13
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(n) As Boolean
isleap = ((n Mod 4 = 0) And (n Mod 400 <> 0))
End Function

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

Function FindYear(n)
'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
 
Hi Rick,
What I was trying to do is calculating Gregorian date of a given Hijri day & month in current Gregorian year at January first.
So first thing which needs to be determined which Hijri year corresponds to 01-01-2016 ( = 1437).
Then calculate Gregorian date of Hijri date in this year.
For example EidAlFitr is Hijri_Month = 10, Hijri_Day = 1 (05 July 2016) and
EidAlAdha is Hijri_Month = 12, Hijri_Day = 10 (11 September 2016)
As separate functions to determine Hijri year at January first and other one to determine Gregorian date of given Hijri date function below works fine.
However when combined like below I get an error "Function call on left-hand side of assignment must return Variant or Object"
Unfortunately I don't know how to solve this error, your help would be much appreciated.
Jurgen

Public Function EidAlFitr(Country As String) As String

Dim EventDate As Date
Dim YearToday As Integer
YearToday = Year(Now())

Dim Hijri_Month As Integer
Dim Hijri_Day As Integer

Hijri_Month = 10
Hijri_Day = 1

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

' Calculate Hijri year at January First
Dim Hijri_Date_1_Jan As String

G = "1/1/" + YearToday

On Error Resume Next
Dim H As Date
If Len(G) > 0 Then
H = CDate(G)
VBA.Calendar = vbCalHijri
Hijri_Date_1_Jan = CStr(H)
VBA.Calendar = vbCalGreg
End If
If Err.Number <> 0 Then Hijri_Date_1_Jan = G

Hijri_Year_1_Jan = Right(Hijri_Date_1_Jan, 4)

' Now calculate actual date in this year
hdat = Hijri_Month + "/" + Hijri_Day + "/" + Hijri_Year_1_Jan
'"10/1/1437"

'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 - 1)
End If
If nyear = 4 Or nyear = 6 Or nyear = 9 Then leap = True
If hmonth = 1 Then
days_thisyear = hday
Else
If leap Then
days_thisyear = MonthFinderL(hmonth - 2) + hday
Else
days_thisyear = MonthFinder(hmonth - 2) + hday
End If
End If
days_thiscycle = days_thiscycle + days_thisyear
EventDate = Cstart - 1 + ncycles * DCycle + days_thiscycle

EidAlFitr = EventDate

End Function
 
Upvote 0

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Jurgen and Rick

Post #14 already has a corrected version of this code, and post #16 shows how to use it in a cell.
It currently works with fixed dates, but this can be easily modified if necessary.
 
Upvote 0
Hi Worf & Rick,
Number 14 does the job indeed, excellent!!
Somehow it did not work before (but it does in a new workbook).
Thx a lot to both.
Kind regards,
Jurgen
 
Upvote 0
Just for my own satisfaction, then, you are wanting to do something like this:

Excel 2013
ABC
1Greg YearHijri DateGreg Date
219901/10/141026/04/1990
319911/10/141115/04/1991
419921/10/141203/04/1992
519931/10/141324/03/1993
619941/10/141413/03/1994
719951/10/141502/03/1995
819961/10/141620/02/1996
919971/10/141708/02/1997
1019981/10/141829/01/1998
1119991/10/141918/01/1999
1220001/10/142007/01/2000
1320011/10/142127/12/2000
1420021/10/142216/12/2001
1520031/10/142305/12/2002
1620041/10/142425/11/2003
1720051/10/142513/11/2004
1820061/10/142603/11/2005
1920071/10/142723/10/2006
2020081/10/142812/10/2007
2120091/10/143020/09/2009
2220101/10/143109/09/2010
2320111/10/143230/08/2011
2420121/10/143318/08/2012
2520131/10/143407/08/2013
2620141/10/143528/07/2014
2720151/10/143617/07/2015
2820161/10/143706/07/2016
2920171/10/143825/06/2017
3020181/10/143914/06/2018
3120191/10/144004/06/2019
3220201/10/144123/05/2020
Sheet2
Cell Formulas
RangeFormula
B2="1/10/" & RIGHT(g2h(DATEVALUE("1/1/" & A2)),4)
C2=h2g(B2)

If so, that does highlight a couple of issues:

What happens when the festival occurs twice in one Gregorian year e.g. 2000?
And what do you do with the missing year e.g. Hijri 1429 when the calendars catch up with one another?



Regards,
 
Upvote 0
Hi Rick,
I only want to show it as an upcoming event if it's within 60 days from now.
When event has passed I'll add 354/355 days
Years like 1429 will give a hick-up indeed.
Kind regards,
Jurgen
 
Upvote 0
OK, so you could just list the next 60 days in a column and use a VLOOKUP to return any festivals.

For instance:

Excel 2013
AB
1DateFestival
31808/12/1438Waqf al Arafa - Hajj
31909/12/1438
32010/12/1438
32111/12/1438Eid-al-Adha
32212/12/1438
32313/12/1438
32414/12/1438
32515/12/1438
32616/12/1438
32717/12/1438
32818/12/1438
32919/12/1438
33020/12/1438
33121/12/1438
33222/12/1438
33323/12/1438
33424/12/1438
33525/12/1438
33626/12/1438
33727/12/1438
33828/12/1438
33929/12/1438
34001/01/1439
34102/01/1439Hijra - Islamic New Year
34203/01/1439
34304/01/1439
34405/01/1439
34506/01/1439
34607/01/1439
34708/01/1439
34809/01/1439
34910/01/1439
35011/01/1439Day of Ashura / Muharram
35112/01/1439
Sheet3
Cell Formulas
RangeFormula
A318=g2h(TODAY()+ROW()-2)
B318=IFERROR(VLOOKUP(LEFT(A318,6),$D$1:$E$11,2,FALSE),"")



Excel 2013
DE
1DateFestival
228/07/Lailat al Miraj
314/08/Lailat al Bara'ah
402/09/Ramadan (start)
527/09/Laylat al Kadr
602/10/Eid-al-Fitr (End of Ramadan)
708/12/Waqf al Arafa - Hajj
811/12/Eid-al-Adha
902/01/Hijra - Islamic New Year
1011/01/Day of Ashura / Muharram
1113/03/Milad un Nabi
Sheet3


I did the whole year so that some festivals became visible but you would only need the next 60 days.
Note: I extracted the dates from a web site so I can't guarantee them.


Regards,
 
Upvote 0
Hi Mr Rick.

Thanks for this awesome code.

If i were to try any date such :

Sub test()
Msgbox G2H("29/05/1984")
End Sub

I would then end up to get the message
"29th of Aug 1404"
where it actually should be " 29th of Syaaban 1404"
( Using twelve month of Hijri : Muharram, Safar, Rabiul Awwal, Rabiul Akhir, Jamadil Awwal, jamadil Akhir, Rajab, Syaaban,
Ramadhan, Syawwal, Dzul Qa'dah, Dzul Hijjah .)

Because i couldnt find any way( i'm new to vba), so i did a little adjustment,

Sub test()
MsgBox Format$(G2H("29/5/1984"), "d-m-yyyy")
End Sub

and the result would appear as : "29/08/1404" .

Is there any way i could change the month to appear based on hijri month?

Thank You
 
Upvote 0
Welcome to the Board

Code:
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, "/")
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("29/05/1984")
End Sub
 
Upvote 0
Welcome to the Board

Code:
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, "/")
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("29/05/1984")
End Sub

Hi Mr Worf.

Thanks for your help, but upon applying your above code i got a little error showing as below :

Run-time error '9':

Subscript out of range.



And when i clicked debug, it pointed to below line of codes :

G2H = v(0) & s & " of " & m(Val(v(1)) - 1) & " " & v(2)

is there any way to solve this?
 
Upvote 0
Please use the version below and tell me what the information message box says:

Code:
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[/SIZE][/FONT][/COLOR]

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

Forum statistics

Threads
1,214,630
Messages
6,120,634
Members
448,973
Latest member
ChristineC

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top