Hijri Gregorian Date Conversion

W

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
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
Hello and welcome to the Board

The code below worked for me:

greg.JPG


Code: 
'****************************************************************************
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
Dim yearfinder, i
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
Dim monthfinderl, monthfinder, i
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 Date
Dim yearfinder, monthfinderl, monthfinder, cstart, hstart, dcycle, i, j, hmonth
Dim nyear, leap, days_thiscycle, days_thisyear, hday, hyear, ncycles, elapsed_years
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
Sub itest()
MsgBox greg_date("12 / 10 / 1436")
End Sub
Public Function Eid_Al_Adha_Hijri$(GregYear As Integer)
Dim hstart, dcycle, yearfinder, cstart, ndays, monthfinderl, hyr, monthfinder, leaph
Dim months, ndays_thiscycle, nyear, ndays_thisyear, elp, daysinmonths, ncycles
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
'*******************************************************************************
 
Upvote 0
Hi and welcome to the MrExcel Message Board.

These will convert Hijri dates:
Code: 
Function G2H(dtGregDate As Date) As String
    ' returns a date in Hijri format for a given western date
    VBA.Calendar = vbCalHijri
    G2H = dtGregDate
    VBA.Calendar = vbCalGreg
End Function

Function H2G(dtHijDate As String) As Date
    ' returns a Gregorian date in from a string containing a Hijri date
    VBA.Calendar = vbCalHijri
    H2G = dtHijDate
    VBA.Calendar = vbCalGreg
End Function

Sub Test_Hijri_Gregorian_Conversion()
    MsgBox H2G("19/12/1437") & vbLf & G2H("21/09/2016")
End Sub
The final macro is a test to show how the functions are used.

I am not sure if you still want your first post answered now or if the above functions will remove the need to alter the Options statement?
http://www.mrexcel.com/forum/excel-questions/969603-how-get-rid-option-base-1-a.html#post4653217

Regards,
 
Last edited:
Upvote 0
I would like to get it working without Option Base 1 activated.


Worf said:
Hello and welcome to the Board

The code below worked for me:

greg.JPG


Code: 
'****************************************************************************
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
Dim yearfinder, i
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
Dim monthfinderl, monthfinder, i
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 Date
Dim yearfinder, monthfinderl, monthfinder, cstart, hstart, dcycle, i, j, hmonth
Dim nyear, leap, days_thiscycle, days_thisyear, hday, hyear, ncycles, elapsed_years
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
Sub itest()
MsgBox greg_date("12 / 10 / 1436")
End Sub
Public Function Eid_Al_Adha_Hijri$(GregYear As Integer)
Dim hstart, dcycle, yearfinder, cstart, ndays, monthfinderl, hyr, monthfinder, leaph
Dim months, ndays_thiscycle, nyear, ndays_thisyear, elp, daysinmonths, ncycles
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
'*******************************************************************************
Click to expand...
 
Upvote 0
Hi Rick,
If possible yes....

Don't think this is OK
Should result in 1437 instead of 1438

Public Function HijriStart() As String
Dim YearToday As String
YearToday = year(Now())
'returns a date in Hijri format for a given western date
VBA.Calendar = vbCalHijri
Hijri_1_Jan = year(DateSerial(YearToday, 1, 1))
HijriStart = Hijri_1_Jan
'http://www.islamicfinder.org/islamic-date-converter/
End Function
 
Upvote 0
I think the code I posted above agrees with the calendar in your link.

What is your Function HijriStart trying to do?


Regards,
 
Upvote 0
Hi Rick,
Was trying to determine Hijri date at January 1st of this year.
Should be 1437
These three functions combined work but I wonder if there isn't an easier way.
If not, how can these be combined in one function without Option base 1
Thx a lot so far!!!
Jurgen


Option Base 1
Public Function Date_Hijri_Short(Dat As Long) As String

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)
Hstart = 1324
DCycle = 2835

elp = Dat - CLng(#2/24/1906#) 'Corresponds to 1 Muharram 1324
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
Date_Hijri_Short = "12/30/" & hyr
Exit Function
End If

nyear = FindYear(ndays_thiscycle) 'This year in current cycle

If nyear = 4 Or nyear = 6 Or nyear = 9 Then leapH = True
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
Date_Hijri_Short = months & "/" & nDays & "/" & hyr
End Function
Public 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
Public 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)

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
 
Upvote 0
If I put "1/1/2016" into my test program it returns: 21/03/1437

Here is the whole thing:
Code: 
Function H2G(ByVal H As String) As String
    On Error Resume Next
    Dim G As Date
    If Len(H) > 0 Then
        VBA.Calendar = vbCalHijri
        G = CDate(H)
        VBA.Calendar = vbCalGreg
        H2G = CStr(G)
    End If
    If Err.Number <> 0 Then H2G = H
End Function

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

Sub test()
    MsgBox G2H("1/1/2016")
End Sub
If you test program is not giving the same answer then may I suggest you look there first for the issue.


Regards,
 
Upvote 0
Hi Rick,
Much appreciated, I'm almost there....
When combining the two functions I now get a "Function call on left-hand side of assignment must return Variant or Object" error.
Kind regards,
Jurgen

Public Function EidAlFitr(Country As String) As String

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

StartShowing = 60
EndShowing = 0

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
If the festival is supposed to be on the same calendar date each year, why not start there and convert them to Gregorian?

For example:
Code: 
Function H2G(ByVal H As String) As String
    On Error Resume Next
    Dim G As Date
    If Len(H) > 0 Then
        VBA.Calendar = vbCalHijri
        G = CDate(H)
        VBA.Calendar = vbCalGreg
        H2G = CStr(G)
    End If
    If Err.Number <> 0 Then H2G = H
End Function

Sub yyy()
    Debug.Print H2G("11/12/1431")
    Debug.Print H2G("11/12/1432")
    Debug.Print H2G("11/12/1433")
    Debug.Print H2G("11/12/1434")
    Debug.Print H2G("11/12/1435")
    Debug.Print H2G("11/12/1436")
    Debug.Print H2G("11/12/1437")
    Debug.Print H2G("11/12/1438")
    Debug.Print H2G("11/12/1439")
    Debug.Print H2G("11/12/1440")
    Debug.Print H2G("11/12/1441")
    Debug.Print H2G("11/12/1442")
    Debug.Print H2G("11/12/1443")
End Sub

Note: You will need to enable the Immediate Window in the VB Editor to see the answers. Use Ctrl + G or the View menu to do that.

It does not quite match the dates in WikiPedia but it sounds as if they are on different dates in different countries and the precise date is only confirmed after taking a sighting of the moon.


Regards,
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question
How to get rid of Option Base 1
Replies
2
Views
768
Worf
Worf
L
  • Question
Need Correction in Custom Function
Replies
1
Views
531
RickXL
RickXL

Forum statistics

Threads
1,214,919
Messages
6,122,260
Members
449,075
Latest member
staticfluids

Share this page

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