Hebrew Calendar Conversion Sample Code in VB6/VBA

HebCalVb6 is a VB6/VBA module to demonstrate how to convert a Hebrew date into the Gregorian date. It can be used within Visual Basic or within a Excel Macro.

There are many books and articles that go into depth explaining the history, math and theory of the Hebrew calendar. My goal here is specifically to demonstrate how to apply these rules. In doing so, I tried to use very generic code without using any fancy language-specific features.

Much of the information is based on the excellent website Hebrew Calendar Science and Myths by Remy Landau, and the book, Glimpse of Light by Dr. J. Schamroth.

If you have any questions or comments, please contact me at info@dafaweek.com. 


' This code demonstrates how to convert a Hebrew date into a
' Gregorian date. The code is written in VB6/VBA, but I purposely
' used very generic features so it would be easy to translate
' this into other languages. Also, I avoided using many
' optimization in order to make the logic clearer.

' These functions assume that all the current rules of the
' Hebrew calendar were always in existence (which is not true
' since the Hebrew calendar was not always fixed) and all the
' current rules of the Gregorian calendar were always in existence
' (which is not true).

' Here is a very brief description of the Hebrew calendar.
'
' The Hebrew calendar is a lunisolar calendar.  This means that
' the months are in sync with the moon and the years stay in sync
' with the sun.  A solar year is approximately 365.25 days.  A
' lunar month is approximately 29.5 days.  Twelve lunar months is
' approximately 354 days (12 * 29.5=354).  Thus, a lunar year of
' twelve months is 11.25 days shorter than the solar year. To make
' up for this shortfall, the Hebrew calendar adds a thirteenth
' month to seven years over a nineteen year period. Therefore, over
' a nineteen year period, the Hebrew calendar is approximately the
' same length as a nineteen year solar calendar.
'
' In order to understand this code, you must know the following
' terms:
'   Molad - new moon. Hebrew months start around the day of the
'           new moon
'   Chalakim - 1 / 1080 of an hour or 3 1/3 seconds
'   Tishrei - the first month of the Hebrew year (at least for
'             these calculations)
'   Rosh Hashanah - The Jewish new year which starts on Tishrei 1.
'
' The Hebrew calendar assumes the period of time between one new
' moon to the next is 29 days, 12 hours and 793 chalakim. The first
' molad after creation occurred on Monday, September, 7th -3760 at 5
' hours and 204 chalakim.  Technically, the Gregorian date would be
' in the year 3761 BCE because there was no year 0 in the Gregorian
' calendar, but we will use the year of -3760.

' Sample Usage:
'    ' Converts AdarB/7/5765 to 4/6/2005
'    MsgBox(HebToGreg(5765, 7, 26))
'

' This function returns how many months there has been from the
' first Molad until the beginning of the year nYearH
Public Function MonSinceFirstMolad(ByVal nYearH As Long) As Long
    Dim nMonSinceFirstMolad As Long

  ' A shortcut to this function can simply be the following formula
  '   Return Int(((235 * nYearH) - 234) / 19)
  ' This formula is found in Remy Landau's website and he
  ' attributes it to Wolfgang Alexander Shochen. I will use a less
  ' optimized function which I believe shows the underlying logic
  ' better.

  ' count how many months there has been in all years up to last
  ' year. The months of this year hasn't happened yet.
  nYearH = nYearH - 1

  
  ' In the 19 year cycle, there will always be 235 months. That
  ' would be 19 years times 12 months plus 7 extra month for the
  ' leap years. (19 * 12) + 7 = 235.

  ' Get how many 19 year cycles there has been and multiply it by
  ' 235

  nMonSinceFirstMolad = Int(nYearH / 19) * 235

  ' Get the remaining years after the last complete 19 year cycle

  nYearH = nYearH Mod 19

  ' Add 12 months for each of those years

  nMonSinceFirstMolad = nMonSinceFirstMolad + (12 * nYearH)

  ' Add the extra months to account for the leap years

  If nYearH >= 17 Then
    nMonSinceFirstMolad = nMonSinceFirstMolad + 6
  ElseIf nYearH >= 14 Then
    nMonSinceFirstMolad = nMonSinceFirstMolad + 5
  ElseIf nYearH >= 11 Then
    nMonSinceFirstMolad = nMonSinceFirstMolad + 4
  ElseIf nYearH >= 8 Then
    nMonSinceFirstMolad = nMonSinceFirstMolad + 3
  ElseIf nYearH >= 6 Then
    nMonSinceFirstMolad = nMonSinceFirstMolad + 2
  ElseIf nYearH >= 3 Then
    nMonSinceFirstMolad = nMonSinceFirstMolad + 1
  End If
  MonSinceFirstMolad = nMonSinceFirstMolad
End Function


' This function returns if a given year is a leap year.

Public Function IsLeapYear(ByVal nYearH As Long) As Boolean
  Dim nYearInCycle As Long


  ' Find out which year we are within the cycle.  The 19th year of
  ' the cycle will return 0

  nYearInCycle = nYearH Mod 19
  IsLeapYear = nYearInCycle = 3 Or _
               nYearInCycle = 6 Or _
               nYearInCycle = 8 Or _
               nYearInCycle = 11 Or _
               nYearInCycle = 14 Or _
               nYearInCycle = 17 Or _
               nYearInCycle = 0
End Function


' This function figures out the Gregorian Date that corresponds to
' the first day of Tishrei, the first month of the Hebrew
' calendar, for a given Hebrew year.

Public Function Tishrei1(ByVal nYearH As Long) As Date
  Dim nMonthsSinceFirstMolad As Long
  Dim nChalakim As Long
  Dim nHours As Long
  Dim nDays As Long
  Dim nDayOfWeek As Long
  Dim dTishrei1 As Date


  ' We want to calculate how many days, hours and chalakim it has
  ' been from the time of 0 days, 0 hours and 0 chalakim to the
  ' molad at the beginning of year nYearH.
  '
  ' The period between one new moon to the next is 29 days, 12
  ' hours and 793 chalakim. We must multiply that by the amount
  ' of months that transpired since the first molad. Then we add
  ' the time of the first molad (Monday, 5 hours and 204 chalakim)

  nMonthsSinceFirstMolad = MonSinceFirstMolad(nYearH)
  nChalakim = 793 * nMonthsSinceFirstMolad
  nChalakim = nChalakim + 204

  ' carry the excess Chalakim over to the hours

  nHours = Int(nChalakim / 1080)
  nChalakim = nChalakim Mod 1080

  nHours = nHours + (nMonthsSinceFirstMolad * 12)
  nHours = nHours + 5

  ' carry the excess hours over to the days

  nDays = Int(nHours / 24)
  nHours = nHours Mod 24

  nDays = nDays + (29 * nMonthsSinceFirstMolad)
  nDays = nDays + 2


  ' figure out which day of the week the molad occurs.
  ' Sunday = 1, Moday = 2 ..., Shabbos = 0

  nDayOfWeek = nDays Mod 7


  ' In a perfect world, Rosh Hashanah would be on the day of the
  ' molad. The Hebrew calendar makes four exceptions where we
  ' push off Rosh Hashanah one or two days. This is done to
  ' prevent three situation. Without explaining why, the three
  ' situations are:
  '   1) We don't want Rosh Hashanah to come out on Sunday,
  '      Wednesday or Friday
  '   2) We don't want Rosh Hashanah to be on the day of the
  '      molad if the molad occurs after the beginning of 18th
  '      hour.
  '   3) We want to limit years to specific lengths.  For non-leap
  '      years, we limit it to either 353, 354 or 355 days.  For
  '      leap years, we limit it to either 383, 384 or 385 days.
  '      If setting Rosh Hashanah to the day of the molad will
  '      cause this year, or the previous year to fall outside
  '      these lengths, we push off Rosh Hashanah to get the year
  '      back to a valid length.
  ' This code handles these exceptions.


  If Not IsLeapYear(nYearH) And _
     nDayOfWeek = 3 And _
     (nHours * 1080) + nChalakim >= _
     (9 * 1080) + 204 Then

    ' This prevents the year from being 356 days. We have to push
    ' Rosh Hashanah off two days because if we pushed it off only
    ' one day, Rosh Hashanah would comes out on a Wednesday. Check
    ' the Hebrew year 5745 for an example.

    nDayOfWeek = 5
    nDays = nDays + 2
  ElseIf IsLeapYear(nYearH - 1) And _
         nDayOfWeek = 2 And _
         (nHours * 1080) + nChalakim >= _
         (15 * 1080) + 589 Then

    ' This prevents the previous year from being 382 days. Check
    ' the Hebrew Year 5766 for an example. If Rosh Hashanah was not
    ' pushed off a day then 5765 would be 382 days

    nDayOfWeek = 3
    nDays = nDays + 1
  Else

    ' see rule 2 above. Check the Hebrew year 5765 for an example

    If nHours >= 18 Then
      nDayOfWeek = nDayOfWeek + 1
      nDayOfWeek = nDayOfWeek Mod 7
      nDays = nDays + 1
    End If

    ' see rule 1 above. Check the Hebrew year 5765 for an example

    If nDayOfWeek = 1 Or _
       nDayOfWeek = 4 Or _
       nDayOfWeek = 6 Then
      nDayOfWeek = nDayOfWeek + 1
      nDayOfWeek = nDayOfWeek Mod 7
      nDays = nDays + 1
    End If
  End If


  ' Here we want to add nDays to creation
  '    dTishrie1 = creation + nDays
  ' Unfortunately, VB doesn't handle negative years very well.
  ' I therefore picked a Random date (1/1/1900) and figured out how
  ' many days it is after the creation (2067025). Then I subtracted
  ' 2067025 from nDays.

  nDays = nDays - 2067025
  dTishrei1 = #1/1/1900# 
' 2067025 days after creation
  dTishrei1 = dTishrei1 + nDays
  Tishrei1 = dTishrei1
End Function


' This function gets the length of a Hebrew year.

Public Function LengthOfYear(ByVal nYearH As Long) As Long
  Dim dThisTishrei1 As Date
  Dim dNextTishrei1 As Date
  Dim diff As Long


  ' subtract the date of this year from the date of next year

  dThisTishrei1 = Tishrei1(nYearH)
  dNextTishrei1 = Tishrei1(nYearH + 1)
  diff = dNextTishrei1 - dThisTishrei1
  LengthOfYear = diff
End Function


' This function converts a Hebrew date into the Gregorian date
' nYearH - is the Hebrew year
' nMonth - Tishrei=1
'          Cheshvon=2
'          Kislev=3
'          Teyvet=4
'          Shevat=5
'          Adar A=6 (only valid on leap years)
'          Adar=7   (Adar B for leap years)
'          Nison=8
'          Iyar=9
'          Sivan=10
'          Tamuz=11
'          Av=12
'          Elul=13

Public Function HebToGreg(ByVal nYearH As Long, _
                          ByVal nMonthH As Long, _
                          ByVal nDateH As Long) As Date
  Dim nLengthOfYear As Long
  Dim bLeap As Boolean
  Dim dGreg As Date
  Dim nMonth As Long
  Dim nMonthLen As Long
  Dim bHaser As Boolean
  Dim bShalem As Boolean

  bLeap = IsLeapYear(nYearH)
  nLengthOfYear = LengthOfYear(nYearH)


  ' The regular length of a non-leap year is 354 days.
  ' The regular length of a leap year is 384 days.
  ' On regular years, the length of the months are as follows
  '   Tishrei (1)   30
  '   Cheshvon(2)   29
  '   Kislev  (3)   30
  '   Teyvet  (4)   29
  '   Shevat  (5)   30
  '   Adar A  (6)   30     (only valid on leap years)
  '   Adar    (7)   29     (Adar B for leap years)
  '   Nison   (8)   30
  '   Iyar    (9)   29
  '   Sivan   (10)  30
  '   Tamuz   (11)  29
  '   Av      (12)  30
  '   Elul    (13)  29
  ' If the year is shorter by one less day, it is called a haser
  ' year. Kislev on a haser year has 29 days. If the year is longer
  ' by one day, it is called a shalem year. Cheshvon on a shalem
  ' year is 30 days.

  bHaser = nLengthOfYear = 353 Or nLengthOfYear = 383
  bShalem = nLengthOfYear = 355 Or nLengthOfYear = 385

  ' get the date for Tishrei 1

  dGreg = Tishrei1(nYearH)
  ' Now count up days within the year

  For nMonth = 1 To nMonthH - 1
    Select Case nMonth
      Case 1, 5, 8, 10, 12 ' 30 day months
        nMonthLen = 30
      Case 4, 7, 9, 11, 13 ' 29 day months
        nMonthLen = 29
      Case 6 ' There is only an Adar A on a leap years
        nMonthLen = IIf(bLeap, 30, 0)
      Case 2 ' Cheshvon, see note above
        nMonthLen = IIf(bShalem, 30, 29)
      Case 3 ' Kislev, see note above
        nMonthLen = IIf(bHaser, 29, 30)
    End Select
    dGreg = dGreg + nMonthLen
  Next
  dGreg = dGreg + (nDateH - 1)
  HebToGreg = dGreg
End Function


' This function converts a Gregorian date into the Hebrew date.  The
' function returns the hebrew month as a string in the format MM/DD/YYYY.
' Also, the parameters nYearH, nMonthH and hDateH, which are sent by
' reference, will get set the Hebrew year, month and date. See function
' HebToGreg() for the definition of the month numbers.

Public Function GregToHeb(ByVal dGreg As Date, _
                          ByRef nYearH As Long, _
                          ByRef nMonthH As Long, _
                          ByRef nDateH As Long) As String
  Dim nOneMolad As Double
  Dim nAvrgYear As Double
  Dim nDays As Long
  Dim dTishrei1 As Date
  Dim nLengthOfYear As Long
  Dim bLeap As Boolean
  Dim bHaser As Boolean
  Dim bShalem As Boolean
  Dim nMonthLen As Long
  Dim bWhile As Boolean


  ' The basic algorythm to get Hebrew date for the Gregorian date dGreg.
  ' 1) Find out how many days dGreg is after creation.
  ' 2) Based on those days, estimate the Hebrew year
  ' 3) Now that we a good estimate of the Hebrew year, use brute force to
  '    find the Gregorian date for Tishrei 1 prior to or equal to dGreg
  ' 4) Add to Tishrei 1 the amount of days dGreg is after Tishrei 1

  ' Figure out how many days are in a month.
  ' 29 days + 12 hours + 793 chalakim


  dGreg = int(dGreg) ' added 04/26/2018 based on e-mail from a Christopher
  nOneMolad = 29 + (12 / 24) + (793 / (1080 * 24))

  ' Figure out the average length of a year. The hebrew year has exactly
  ' 235 months over 19 years.

  nAvrgYear = nOneMolad * (235 / 19)

  ' Get how many days dGreg is after creation. See note as to why I
  ' use 1/1/1900 and add 2067025

  nDays = dGreg - #1/1/1900#
  nDays = nDays + 2067025 ' 2067025 days after creation 
  ' Guess the Hebrew year. This should be a pretty accurate guess.

  nYearH = Int(CDbl(nDays) / nAvrgYear) + 1

  ' Use brute force to find the exact year nYearH. It is the Tishrei 1 in
  ' the year <= dGreg.

  dTishrei1 = Tishrei1(nYearH)
  If dTishrei1 = dGreg Then

    ' If we got lucky and landed on the exact date, we can stop here

    nMonthH = 1
    nDateH = 1
  Else

    ' Here is the brute force.  Either count up or count down nYearH
    ' until Tishrei 1 is <= dGreg.

    If dTishrei1 < dGreg Then

      ' If Tishrei 1, nYearH is less than dGreg, count nYearH up.

      Do While Tishrei1(nYearH + 1) <= dGreg
        nYearH = nYearH + 1
      Loop
    Else

      ' If Tishrei 1, nYearH is greater than dGreg, count nYearH down.

      nYearH = nYearH - 1
      Do While Tishrei1(nYearH) > dGreg
        nYearH = nYearH - 1
      Loop
    End If


    ' Subtract Tishrei 1, nYearH from dGreg. That should leave us with
    ' how many days we have to add to Tishrei 1

    nDays = dGreg - Tishrei1(nYearH)


    ' Find out what type of year it is so that we know the length of the
    ' months

    nLengthOfYear = LengthOfYear(nYearH)
    bHaser = nLengthOfYear = 353 Or nLengthOfYear = 383
    bShalem = nLengthOfYear = 355 Or nLengthOfYear = 385
    bLeap = IsLeapYear(nYearH)


    ' Add nDays to Tishrei 1.

    nMonthH = 1
    Do
      Select Case nMonthH
        Case 1, 5, 8, 10, 12' 30 day months
          nMonthLen = 30
        Case 4, 7, 9, 11, 13' 29 day months
          nMonthLen = 29
        Case 6 ' Adar A (6) will be skipped on non-leap years
          nMonthLen = 30
        Case 2 ' Cheshvon, see note above
          nMonthLen = IIf(bShalem, 30, 29)
        Case 3 ' Kislev, see note above
          nMonthLen = IIf(bHaser, 29, 30)
      End Select
      If nDays >= nMonthLen Then
        bWhile = True
        If bLeap Or nMonthH <> 5 Then
          nMonthH = nMonthH + 1
        Else

          ' We can skip Adar A (6) if its not a leap year

          nMonthH = nMonthH + 2
        End If
        nDays = nDays - nMonthLen
      Else
        bWhile = False
      End If
    Loop While bWhile

    ' Add the remaining days to Date

    nDateH = nDays + 1
  End If
  GregToHeb = CStr(nMonthH) & "/" & CStr(nDateH) & "/" & CStr(nYearH)
End Function

Public Function FormatDateH(nYearH, nMonthH, nDateH)
  Dim sMonth As String
  Select Case nMonthH
    Case 1
      sMonth = "Tishrei"
    Case 2
      sMonth = "Cheshvan"
    Case 3
      sMonth = "Kislev"
    Case 4
      sMonth = "Teves"
    Case 5
      sMonth = "Shevat"
    Case 6
      sMonth = "Adar A"
    Case 7
      sMonth = IIf(IsLeapYear(nYearH), "Adar B", "Adar")
    Case 8
      sMonth = "Nisan"
    Case 9
      sMonth = "Iyar"
    Case 10
      sMonth = "Sivan"
    Case 11
      sMonth = "Tamuz"
    Case 12
      sMonth = "Av"
    Case 13
      sMonth = "Elul"
  End Select
  FormatDateH = sMonth & " " & CStr(nDateH) & " " & CStr(nYearH)
End Function

Public Function TodayHeb()
  Dim nYearH As Long
  Dim nMonthH As Long
  Dim nDateH As Long
  Dim dToday As Date
  
  dToday = Int(Now())
  GregToHeb dToday, nYearH, nMonthH, nDateH
  TodayHeb = FormatDateH(nYearH, nMonthH, nDateH)
End Function

Public Function DateToHeb(dDate)
  Dim nYearH As Long
  Dim nMonthH As Long
  Dim nDateH As Long
  
  dDate = CDate(dDate)
  GregToHeb dDate, nYearH, nMonthH, nDateH
  DateToHeb = FormatDateH(nYearH, nMonthH, nDateH)
End Function



'''' Some helper hebrew functions ''''



Function HebrewNum(ByVal n As Integer)
  Dim nX As Integer
  Dim sHundred As String
  Dim sTen As String
  Dim sOne As String
  
  n = n Mod 1000
  nX = n - (n Mod 100)
  Select Case nX
    Case 900
      sHundred = Tuf_() & Tuf_() & Raish_()
    Case 800
      sHundred = Tuf_() & Tuf_() & Kuf_()
    Case 700
      sHundred = Tuf_() & Shin_()
    Case 600
      sHundred = Tuf_() & Raish_()
    Case 500
      sHundred = Tuf_() & Kuf_()
    Case 400
      sHundred = Tuf_()
    Case 300
      sHundred = Shin_()
    Case 200
      sHundred = Raish_()
    Case 100
      sHundred = Kuf_()
  End Select
  n = n - nX
  If n = 15 Then
    sTen = Tes_()
    sOne = Vav_()
  ElseIf n = 16 Then
    sTen = Tes_()
    sOne = Ziyon_()
  Else
    nX = n - (n Mod 10)
    Select Case nX
      Case 90
        sTen = Tzodi_()
      Case 80
        sTen = Pai_()
      Case 70
        sTen = Iyin_()
      Case 60
        sTen = Samech_()
      Case 50
        sTen = Nun_()
      Case 40
        sTen = Mem_()
      Case 30
        sTen = Lamed_()
      Case 20
        sTen = Chaf_()
      Case 10
        sTen = Yud_()
    End Select
    nX = n - nX
    Select Case nX
      Case 9
        sOne = Tes_()
      Case 8
        sOne = Ches_()
      Case 7
        sOne = Ziyon_()
      Case 6
        sOne = Vav_()
      Case 5
        sOne = Hai_()
      Case 4
        sOne = Daled_()
      Case 3
        sOne = Gimmel_()
      Case 2
        sOne = Bais_()
      Case 1
        sOne = Alef_()
    End Select
  End If
  
  HebrewNum = sHundred & sTen & sOne
End Function

Public Function FormatDateHInHeb(nYearH, nMonthH, nDateH)
  Dim sMonth As String
  Select Case nMonthH
    Case 1
      sMonth = Tuf_() & Shin_() & Raish_() & Yud_()
    Case 2
      sMonth = Ches_() & Shin_() & Vav_() & Nun_End_()
    Case 3
      sMonth = Chaf_() & Samech_() & Lamed_() & Yud_() & Vav_()
    Case 4
      sMonth = Tes_() & Bais_() & Tuf_()
    Case 5
      sMonth = Shin_() & Bais_() & Tes_()
    Case 6
      sMonth = Alef_() & Daled_() & Raish_() & ChrW(32) & Alef_()
    Case 7
      sMonth = IIf(IsLeapYear(nYearH), _
                     Alef_() & Daled_() & Raish_() & ChrW(32) & Bais_(), _
                     Alef_() & Daled_() & Raish_())
    Case 8
      sMonth = Nun_() & Yud_() & Samech_() & Nun_End_()
    Case 9
      sMonth = Alef_() & Yud_() & Yud_() & Raish_()
    Case 10
      sMonth = Samech_() & Yud_() & Vav_() & Nun_End_()
    Case 11
      sMonth = Tuf_() & Mem_() & Vav_() & Ziyon_()
    Case 12
      sMonth = Alef_() & Bais_()
    Case 13
      sMonth = Alef_() & Lamed_() & Vav_() & Lamed_()
  End Select
  FormatDateHInHeb = sMonth & " " & HebrewNum(nDateH) & " " & CStr(nYearH)
  
  ' FormatDateHInHeb = sMonth & " " & HebrewNum(nDateH) & " " & HebrewNum(nYearH)
  
  
End Function


Public Function HebDateInHeb(dDate)
  Dim nYearH As Long
  Dim nMonthH As Long
  Dim nDateH As Long
  
  dDate = CDate(dDate)
  GregToHeb dDate, nYearH, nMonthH, nDateH
  HebDateInHeb = FormatDateHInHeb(nYearH, nMonthH, nDateH)
End Function

Function Alef_()
  Alef_ = ChrW(1488)
End Function

Function Bais_()
  Bais_ = ChrW(1489)
End Function

Function Gimmel_()
  Gimmel_ = ChrW(1490)
End Function

Function Daled_()
  Daled_ = ChrW(1491)
End Function

Function Hai_()
  Hai_ = ChrW(1492)
End Function

Function Vav_()
  Vav_ = ChrW(1493)
End Function

Function Ziyon_()
  Ziyon_ = ChrW(1494)
End Function

Function Ches_()
  Ches_ = ChrW(1495)
End Function

Function Tes_()
  Tes_ = ChrW(1496)
End Function

Function Yud_()
  Yud_ = ChrW(1497)
End Function

Function Chaf_End_()
  Chaf_End_ = ChrW(1498)
End Function

Function Chaf_()
  Chaf_ = ChrW(1499)
End Function

Function Lamed_()
  Lamed_ = ChrW(1500)
End Function

Function Mem_End_()
  Mem_End_ = ChrW(1501)
End Function

Function Mem_()
Mem_ = ChrW(1502)
End Function

Function Nun_End_()
   Nun_End_ = ChrW(1503)
End Function

Function Nun_()
  Nun_ = ChrW(1504)
End Function

Function Samech_()
  Samech_ = ChrW(1505)
End Function

Function Iyin_()
  Iyin_ = ChrW(1506)
End Function

Function Pai_End_()
  Pai_End_ = ChrW(1507)
End Function

Function Pai_()
  Pai_ = ChrW(1508)
End Function

Function Tzodi_End_()
  Tzodi_End_ = ChrW(1509)
End Function

Function Tzodi_()
  Tzodi_ = ChrW(1510)
End Function

Function Kuf_()
  Kuf_ = ChrW(1511)
End Function

Function Raish_()
  Raish_ = ChrW(1512)
End Function

Function Shin_()
  Shin_ = ChrW(1513)
End Function

Function Tuf_()
  Tuf_ = ChrW(1514)
End Function

Function UnicodeChar(n As Integer)
  UnicodeChar = ChrW(n)
End Function


' Some handy code to help generate code

Public Sub MakeHebrewLet()
  Dim nRow As Integer
  Sheets.Add
  ActiveSheet.Name = "HebrewLet"
  For nRow = 1 To 27
    Cells(nRow, 1) = nRow + 1487
    Cells(nRow, 2) = ChrW(nRow + 1487)
    Select Case nRow
      Case 1
        Cells(nRow, 3) = "Alef"
      Case 2
        Cells(nRow, 3) = "Bais"
      Case 3
        Cells(nRow, 3) = "Gimmel"
      Case 4
        Cells(nRow, 3) = "Daled"
      Case 5
        Cells(nRow, 3) = "Hai"
      Case 6
        Cells(nRow, 3) = "Vav"
      Case 7
        Cells(nRow, 3) = "Ziyon"
      Case 8
        Cells(nRow, 3) = "Ches"
      Case 9
        Cells(nRow, 3) = "Tes"
      Case 10
        Cells(nRow, 3) = "Yud"
      Case 11
        Cells(nRow, 3) = "Chaf_End"
      Case 12
        Cells(nRow, 3) = "Chaf"
      Case 13
        Cells(nRow, 3) = "Lamed"
      Case 14
        Cells(nRow, 3) = "Mem_End"
      Case 15
        Cells(nRow, 3) = "Mem"
      Case 16
        Cells(nRow, 3) = "Nun_End"
      Case 17
        Cells(nRow, 3) = "Nun"
      Case 18
        Cells(nRow, 3) = "Samech"
      Case 19
        Cells(nRow, 3) = "Iyin"
      Case 20
        Cells(nRow, 3) = "Pai_End"
      Case 21
        Cells(nRow, 3) = "Pai"
      Case 22
        Cells(nRow, 3) = "Tzodi_End"
      Case 23
        Cells(nRow, 3) = "Tzodi"
      Case 24
        Cells(nRow, 3) = "Kuf"
      Case 25
        Cells(nRow, 3) = "Raish"
      Case 26
        Cells(nRow, 3) = "Shin"
      Case 27
        Cells(nRow, 3) = "Tuf"
    End Select
  Next
End Sub

Public Function HebSt(s As String)
  Dim n As Integer
  

  For n = 1 To Len(s)
    If n <> 1 Then
      HebSt = HebSt + " & "
    End If
    HebSt = HebSt + HebLetToFunc(Mid(s, n, 1))
  Next
End Function

Function HebLetToFunc(sHebLet As String) As String
  Dim nRow As Integer
  HebLetToFunc = "ChrW(" + CStr(AscW(sHebLet)) & ")"
  nRow = 1
  Do While Sheets("HebrewLet").Cells(nRow, 2) <> ""
    If Sheets("HebrewLet").Cells(nRow, 2) = sHebLet Then
      HebLetToFunc = Sheets("HebrewLet").Cells(nRow, 3) & "_()"
      Exit Do
    End If
    nRow = nRow + 1
  Loop
End Function

' ABGDHVZJTYCLMNSIPQKRWX
Function ToHebSt(sHebSt As String) As String
  Dim n As Integer
  Dim sCh As String
  Dim sHebCh As String
  For n = 1 To Len(sHebSt)
    sCh = Mid(sHebSt, n, 1)
    Select Case sCh
      Case "A" ' Alef
        sHebCh = ChrW(1488)
      Case "B" ' Beis
        sHebCh = ChrW(1489)
      Case "G" ' Gimmel
        sHebCh = ChrW(1490)
      Case "D" ' Daled
        sHebCh = ChrW(1491)
      Case "H" ' Hay
        sHebCh = ChrW(1492)
      Case "V" ' Vav
        sHebCh = ChrW(1493)
      Case "Z" ' Ziyen
        sHebCh = ChrW(1494)
      Case "J" ' Ches
        sHebCh = ChrW(1495)
      Case "T" ' Tes
        sHebCh = ChrW(1496)
      Case "Y" ' Yud
        sHebCh = ChrW(1497)
      Case "c" ' cuff Sofit
        sHebCh = ChrW(1498)
      Case "C" ' Cuff
        sHebCh = ChrW(1499)
      Case "L" ' Lamed
        sHebCh = ChrW(1500)
      Case "m" ' Mem Sofit
        sHebCh = ChrW(1501)
      Case "M" ' Mem
        sHebCh = ChrW(1502)
      Case "n" ' Nun Sofit
        sHebCh = ChrW(1503)
      Case "N" ' Nun
        sHebCh = ChrW(1504)
      Case "S" ' Samech
        sHebCh = ChrW(1505)
      Case "I" ' Iyin
        sHebCh = ChrW(1506)
      Case "p" ' Pei Sofit
        sHebCh = ChrW(1507)
      Case "P" ' Pei
        sHebCh = ChrW(1508)
      Case "q" ' Tzadi Sofit
        sHebCh = ChrW(1509)
      Case "Q" ' Tzadi
        sHebCh = ChrW(1510)
      Case "K" ' Koof
        sHebCh = ChrW(1511)
      Case "R" ' Reish
        sHebCh = ChrW(1512)
      Case "W" ' Shin
        sHebCh = ChrW(1513)
      Case "X" ' Tuff
        sHebCh = ChrW(1514)
      Case Else
        sHebCh = sCh
    End Select
    ToHebSt = ToHebSt & sHebCh
  Next
End Function

Public Function HebFormatDateH(nYearH, nMonthH, nDateH)
  Dim sMonth As String
  Select Case nMonthH
    Case 1
      sMonth = ToHebSt("XWRY") ' Tishrei
    Case 2
      sMonth = ToHebSt("JWVn") ' Cheshvan
    Case 3
      sMonth = ToHebSt("CSLV") ' Kislev
    Case 4
      sMonth = ToHebSt("TBX") ' Teves
    Case 5
      sMonth = ToHebSt("WBT") ' Shevat
    Case 6
      sMonth = ToHebSt("ADR A") ' Adar A
    Case 7
      sMonth = IIf(IsLeapYear(nYearH), ToHebSt("ADR B"), ToHebSt("ADR")) ' Adar B, Adar
    Case 8
      sMonth = ToHebSt("NYSn") ' Nisan
    Case 9
      sMonth = ToHebSt("AYYR") ' Iyar
    Case 10
      sMonth = ToHebSt("SYVn") ' Sivan
    Case 11
      sMonth = ToHebSt("XMVZ") ' Tamuz
    Case 12
      sMonth = ToHebSt("AB") ' Av
    Case 13
      sMonth = ToHebSt("ALVL") ' Elul
  End Select
  HebFormatDateH = sMonth & " " & CStr(nDateH) & " " & CStr(nYearH)
End Function

Public Function HebDateToHeb(dDate)
  Dim nYearH As Long
  Dim nMonthH As Long
  Dim nDateH As Long
  
  dDate = CDate(dDate)
  GregToHeb dDate, nYearH, nMonthH, nDateH
  HebDateToHeb = HebFormatDateH(nYearH, nMonthH, nDateH)
End Function



'''' Code to get the Shabbos Parsha '''' 



Function GetParsha(d As Date) As String
  GetParsha = GetParshaX(d, 1, True)
End Function

Function GetParshaHeb(d As Date) As String
  GetParshaHeb = GetParshaX(d, 2, True)
End Function

Function GetParshaHebYesParshas(d As Date) As String
  GetParshaHebNoParshas = GetParshaX(d, 2, False)
End Function

Function GetParshaNum(d As Date) As String
  GetParshaNum = GetParshaX(d, 3)
End Function

Private Function GetParshaX(d As Date, nType As Integer, Optional bNoPRWX As Boolean) As String
  Dim nParshaNumber As Integer
  Dim dTargetShabbos As Date
  Dim dWorkingShabbos As Date
  Dim nYearH As Long
  Dim nMonthH As Long
  Dim nDateH As Long
  Dim bIsYomTov As Boolean
  Dim bDoubleParsha As Boolean
  Dim bSpecialParsha As Boolean
  Dim bDone As Boolean
  Dim sParsha As String
  Dim aParsha(64) As String

  If nType = 1 Then
    aParsha(1) = "Bereishit"
    aParsha(2) = "Noach"
    aParsha(3) = "Lech Lecha"
    aParsha(4) = "Vayeira"
    aParsha(5) = "Chayei Sarah"
    aParsha(6) = "Toldot"
    aParsha(7) = "Vayeitzei"
    aParsha(8) = "Vayishlach"
    aParsha(9) = "Vayeishev"
    aParsha(10) = "Mikeitz"
    aParsha(11) = "Vayigash"
    aParsha(12) = "Vayechi"
    aParsha(13) = "Shemot"
    aParsha(14) = "Va'eira"
    aParsha(15) = "Bo"
    aParsha(16) = "Beshalach"
    aParsha(17) = "Yitro"
    aParsha(18) = "Mishpatim"
    aParsha(19) = "Terumah"
    aParsha(20) = "Titzaveh"
    aParsha(21) = "Ki Tisa"
    aParsha(22) = "Vayakhel"
    aParsha(23) = "Pekudei"
    aParsha(24) = "Vayikra"
    aParsha(25) = "Tzav"
    aParsha(26) = "Shemini"
    aParsha(27) = "Tazria"
    aParsha(28) = "Metzora"
    aParsha(29) = "Acharei Mot"
    aParsha(30) = "Kedoshim"
    aParsha(31) = "Emor"
    aParsha(32) = "Behar"
    aParsha(33) = "Bechukotai"
    aParsha(34) = "Bamidbar"
    aParsha(35) = "Nasso"
    aParsha(36) = "Beha'alotcha"
    aParsha(37) = "Shelach"
    aParsha(38) = "Korach"
    aParsha(39) = "Chukat"
    aParsha(40) = "Balak"
    aParsha(41) = "Pinchas"
    aParsha(42) = "Mattot"
    aParsha(43) = "Masei"
    aParsha(44) = "Devarim"
    aParsha(45) = "Ve'etchanan"
    aParsha(46) = "Eikev"
    aParsha(47) = "Re'eh"
    aParsha(48) = "Shoftim"
    aParsha(49) = "Ki Teitzei"
    aParsha(50) = "Ki Tavo"
    aParsha(51) = "Nitzavim"
    aParsha(52) = "Vayeilech"
    aParsha(53) = "Haazinu"
    aParsha(54) = "V'zot HaBrachah"
    aParsha(55) = "Rosh Hashana"
    aParsha(56) = "Yom Kippur"
    aParsha(57) = "Succos"
    aParsha(58) = "Chol Hamoed Succos"
    aParsha(59) = "Hoshana Raba"
    aParsha(60) = "Shmini Atzeres"
    aParsha(61) = "Simchas Torah"
    aParsha(62) = "Rosh Chodesh"
    aParsha(63) = "Chanukah"
    aParsha(64) = "Asara B'Teves"
  Else
    aParsha(1) = ChrW(1489) & ChrW(1512) & ChrW(1488) & ChrW(1513) & ChrW(1497) & ChrW(1514)
    aParsha(2) = ChrW(1504) & ChrW(1495)
    aParsha(3) = ChrW(1500) & ChrW(1498) & ChrW(32) & ChrW(1500) & ChrW(1498)
    aParsha(4) = ChrW(1493) & ChrW(1497) & ChrW(1512) & ChrW(1488)
    aParsha(5) = ChrW(1495) & ChrW(1497) & ChrW(1497) & ChrW(32) & ChrW(1513) & ChrW(1512) & ChrW(1492)
    aParsha(6) = ChrW(1514) & ChrW(1493) & ChrW(1500) & ChrW(1491) & ChrW(1514)
    aParsha(7) = ChrW(1493) & ChrW(1497) & ChrW(1510) & ChrW(1488)
    aParsha(8) = ChrW(1493) & ChrW(1497) & ChrW(1513) & ChrW(1500) & ChrW(1495)
    aParsha(9) = ChrW(1493) & ChrW(1497) & ChrW(1513) & ChrW(1489)
    aParsha(10) = ChrW(1502) & ChrW(1511) & ChrW(1509)
    aParsha(11) = ChrW(1493) & ChrW(1497) & ChrW(1490) & ChrW(1513)
    aParsha(12) = ChrW(1493) & ChrW(1497) & ChrW(1495) & ChrW(1497)
    aParsha(13) = ChrW(1513) & ChrW(1502) & ChrW(1493) & ChrW(1514)
    aParsha(14) = ChrW(1493) & ChrW(1488) & ChrW(1512) & ChrW(1488)
    aParsha(15) = ChrW(1489) & ChrW(1488)
    aParsha(16) = ChrW(1489) & ChrW(1513) & ChrW(1500) & ChrW(1495)
    aParsha(17) = ChrW(1497) & ChrW(1514) & ChrW(1512) & ChrW(1493)
    aParsha(18) = ChrW(1502) & ChrW(1513) & ChrW(1508) & ChrW(1496) & ChrW(1497) & ChrW(1501)
    aParsha(19) = ChrW(1514) & ChrW(1512) & ChrW(1493) & ChrW(1502) & ChrW(1492)
    aParsha(20) = ChrW(1514) & ChrW(1510) & ChrW(1493) & ChrW(1492)
    aParsha(21) = ChrW(1499) & ChrW(1497) & ChrW(32) & ChrW(1514) & ChrW(1513) & ChrW(1488)
    aParsha(22) = ChrW(1493) & ChrW(1497) & ChrW(1511) & ChrW(1492) & ChrW(1500)
    aParsha(23) = ChrW(1508) & ChrW(1511) & ChrW(1493) & ChrW(1491) & ChrW(1497)
    aParsha(24) = ChrW(1493) & ChrW(1497) & ChrW(1511) & ChrW(1512) & ChrW(1488)
    aParsha(25) = ChrW(1510) & ChrW(1493)
    aParsha(26) = ChrW(1513) & ChrW(1502) & ChrW(1497) & ChrW(1504) & ChrW(1497)
    aParsha(27) = ChrW(1514) & ChrW(1494) & ChrW(1512) & ChrW(1497) & ChrW(1506)
    aParsha(28) = ChrW(1502) & ChrW(1510) & ChrW(1493) & ChrW(1512) & ChrW(1506)
    aParsha(29) = ChrW(1488) & ChrW(1495) & ChrW(1512) & ChrW(1497) & ChrW(32) & ChrW(1502) & ChrW(1493) & ChrW(1514)
    aParsha(30) = ChrW(1511) & ChrW(1491) & ChrW(1513) & ChrW(1497) & ChrW(1501)
    aParsha(31) = ChrW(1488) & ChrW(1502) & ChrW(1493) & ChrW(1512)
    aParsha(32) = ChrW(1489) & ChrW(1492) & ChrW(1512)
    aParsha(33) = ChrW(1489) & ChrW(1495) & ChrW(1511) & ChrW(1514) & ChrW(1497)
    aParsha(34) = ChrW(1489) & ChrW(1502) & ChrW(1491) & ChrW(1489) & ChrW(1512)
    aParsha(35) = ChrW(1504) & ChrW(1513) & ChrW(1488)
    aParsha(36) = ChrW(1489) & ChrW(1492) & ChrW(1506) & ChrW(1500) & ChrW(1514) & ChrW(1498)
    aParsha(37) = ChrW(1513) & ChrW(1500) & ChrW(1495) & ChrW(32) & ChrW(1500) & ChrW(1498)
    aParsha(38) = ChrW(1511) & ChrW(1512) & ChrW(1495)
    aParsha(39) = ChrW(1495) & ChrW(1511) & ChrW(1514)
    aParsha(40) = ChrW(1489) & ChrW(1500) & ChrW(1511)
    aParsha(41) = ChrW(1508) & ChrW(1497) & ChrW(1504) & ChrW(1495) & ChrW(1505)
    aParsha(42) = ChrW(1502) & ChrW(1496) & ChrW(1493) & ChrW(1514)
    aParsha(43) = ChrW(1502) & ChrW(1505) & ChrW(1506) & ChrW(1497)
    aParsha(44) = ChrW(1491) & ChrW(1489) & ChrW(1512) & ChrW(1497) & ChrW(1501)
    aParsha(45) = ChrW(1493) & ChrW(1488) & ChrW(1514) & ChrW(1495) & ChrW(1504) & ChrW(1503)
    aParsha(46) = ChrW(1506) & ChrW(1511) & ChrW(1489)
    aParsha(47) = ChrW(1512) & ChrW(1488) & ChrW(1492)
    aParsha(48) = ChrW(1513) & ChrW(1493) & ChrW(1508) & ChrW(1496) & ChrW(1497) & ChrW(1501)
    aParsha(49) = ChrW(1499) & ChrW(1497) & ChrW(32) & ChrW(1514) & ChrW(1510) & ChrW(1488)
    aParsha(50) = ChrW(1499) & ChrW(1497) & ChrW(32) & ChrW(1514) & ChrW(1489) & ChrW(1493) & ChrW(1488)
    aParsha(51) = ChrW(1504) & ChrW(1510) & ChrW(1489) & ChrW(1497) & ChrW(1501)
    aParsha(52) = ChrW(1493) & ChrW(1497) & ChrW(1500) & ChrW(1498)
    aParsha(53) = ChrW(1492) & ChrW(1488) & ChrW(1494) & ChrW(1497) & ChrW(1504) & ChrW(1493)
    aParsha(54) = ChrW(1493) & ChrW(1494) & ChrW(1488) & ChrW(1514) & ChrW(32) & ChrW(1492) & ChrW(1489) & ChrW(1512) & ChrW(1499) & ChrW(1492)
    aParsha(55) = ChrW(1512) & ChrW(1488) & ChrW(1513) & ChrW(32) & ChrW(1492) & ChrW(1513) & ChrW(1504) & ChrW(1492)
    aParsha(56) = ChrW(1497) & ChrW(1493) & ChrW(1501) & ChrW(32) & ChrW(1499) & ChrW(1497) & ChrW(1508) & ChrW(1493) & ChrW(1512)
    aParsha(57) = ChrW(1505) & ChrW(1493) & ChrW(1499) & ChrW(1493) & ChrW(1514)
    aParsha(58) = ChrW(1495) & ChrW(1493) & ChrW(1492) & ChrW(34) & ChrW(1502) & ChrW(32) & ChrW(1505) & ChrW(1493) & ChrW(1499) & ChrW(1493) & ChrW(1514)
    aParsha(59) = ChrW(1492) & ChrW(1493) & ChrW(1513) & ChrW(1506) & ChrW(1504) & ChrW(1488) & ChrW(32) & ChrW(1512) & ChrW(1489) & ChrW(1488)
    aParsha(60) = ChrW(1513) & ChrW(1502) & ChrW(1497) & ChrW(1504) & ChrW(1497) & ChrW(32) & ChrW(1506) & ChrW(1510) & ChrW(1512) & ChrW(1514)
    aParsha(61) = ChrW(1513) & ChrW(1502) & ChrW(1495) & ChrW(1514) & ChrW(32) & ChrW(1514) & ChrW(1493) & ChrW(1512) & ChrW(1492)
    aParsha(62) = ChrW(1512) & ChrW(1488) & ChrW(1513) & ChrW(32) & ChrW(1495) & ChrW(1493) & ChrW(1491) & ChrW(1513)
    aParsha(63) = ChrW(1495) & ChrW(1504) & ChrW(1493) & ChrW(1499) & ChrW(1492)
    aParsha(64) = ChrW(1506) & ChrW(1513) & ChrW(1512) & ChrW(1492) & ChrW(32) & ChrW(1489) & ChrW(1496) & ChrW(1489) & ChrW(1514)
  End If

  dTargetShabbos = ShabbosOfDate(d)
  dWorkingShabbos = InitWorkingShabbos(d)
  nParshaNumber = (dTargetShabbos - dWorkingShabbos) / 7
  If nParshaNumber < 22 Then
    sParsha = aParsha(nParshaNumber)
  Else
    dWorkingShabbos = dWorkingShabbos + (7 * 22)
    nParshaNumber = 22
    Do While Not bDone
      GregToHeb dWorkingShabbos, nYearH, nMonthH, nDateH
      bIsYomTov = IsYomTov(nYearH, nMonthH, nDateH)
      bDoubleParsha = False
      Select Case nParshaNumber
        Case 22
          If DaysBeforePesach(dWorkingShabbos, nYearH) < 21 Then
            bDoubleParsha = True
          End If
        Case 27, 29
          If Not IsLeapYear(nYearH) Then
            bDoubleParsha = True
          End If
        Case 32
          If IsIsrael Then
            ' Inside Israel: Combine if Passover does not start on Shabbat AND NOT a leap year.
            ' The Passover exception only occurs in a 354-day year in which Rosh HaShanah starts on Thursda
          Else
            If Not IsLeapYear(nYearH) Then
              bDoubleParsha = True
            End If
          End If
        Case 39
          If Not IsIsrael Then
            ' if Pesach falls out on thursday
            If Weekday(HebToGreg(nYearH, 8, 15)) = vbThursday Then
              bDoubleParsha = True
            End If
          End If
        Case 42
          If DaysBeforeTishaBav(dWorkingShabbos, nYearH) < 14 Then
            bDoubleParsha = True
          End If
        Case 51
          If Weekday(HebToGreg(nYearH + 1, 1, 1)) = vbSaturday Or _
             Weekday(HebToGreg(nYearH + 1, 1, 10)) = vbSaturday Then
            bDoubleParsha = True
          End If
      End Select
      If dTargetShabbos = dWorkingShabbos Then
        If bIsYomTov Then
          If nType = 1 Then
            sParsha = TheYomTov(nYearH, nMonthH, nDateH, dWorkingShabbos)
          Else
            sParsha = TheYomTovHeb(nYearH, nMonthH, nDateH, dWorkingShabbos)
          End If  
          bDone = True
        Else
          sParsha = aParsha(nParshaNumber)
          If bDoubleParsha Then
            sParsha = sParsha & "-" & aParsha(nParshaNumber + 1)
          End If
          bDone = True
        End If
      End If
      If Not bDone Then
        If nParshaNumber > UBound(aParsha) Then
          sParsha = "Hmmm" ' debug
          bDone = True
        Else
          If Not bIsYomTov Then
            If bDoubleParsha Then
              nParshaNumber = nParshaNumber + 2
            Else
              nParshaNumber = nParshaNumber + 1
            End If
          End If
          dWorkingShabbos = dWorkingShabbos + 7
        End If
      End If
    Loop
  End If
  If Not bIsYomTov And Len(sParsha) < 9 And Not bNoPRWX Then
    sParsha = ToHebSt("PRWX") & " " & sParsha
  End If
  GetParshaX = sParsha
End Function

Function TheYomTov(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As String
  If IsRoshHashana(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Rosh Hashana"
  ElseIf IsYomKippur(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Yom Kippur"
  ElseIf IsSuccosYT(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Succos"
  ElseIf IsSuccosCH(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Chol Hamoed Succos"
  ElseIf IsHoshanaRaba(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Hoshana Raba"
  ElseIf IsShminiAtzeres(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Shmini Atzeres"
  ElseIf IsSimchasTorah(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Simchas Torah"
  ElseIf IsChanukah(nYearH, nMonthH, nDateH) And _
         IsRoshChodesh(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Chanukah/R""Ch"
  ElseIf IsChanukah(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Chanukah"
  ElseIf IsRoshChodesh(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Rosh Chodesh"
  ElseIf IsPesachYT(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Pesach"
  ElseIf IsPesachCH(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Chol Hamoed Pesach"
  ElseIf IsShavuos(nYearH, nMonthH, nDateH) Then
    TheYomTov = "Shevuos"
  Else
    TheYomTov = ""
  End If
End Function

Function TheYomTovHeb(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As String
  If IsRoshHashana(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("RAW HWNH")
  ElseIf IsYomKippur(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("YVm CYPVR")
  ElseIf IsSuccosYT(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("SVCVX")
  ElseIf IsSuccosCH(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("JVH""M SVCVX")
  ElseIf IsHoshanaRaba(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("HVWINA RBA")
  ElseIf IsShminiAtzeres(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("WMYNY IQRX")
  ElseIf IsSimchasTorah(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("WMJX XVRH")
  ElseIf IsChanukah(nYearH, nMonthH, nDateH) And _
         IsRoshChodesh(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("JNVCH / R""J")
  ElseIf IsChanukah(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("JNVCH")
  ElseIf IsRoshChodesh(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("RAW JVDW")
  ElseIf Is10Teves(nYearH, nMonthH, nDateH, dDate) Then
    TheYomTovHeb = ToHebSt("IWRH BTBX")
  ElseIf Is15Shevat(nYearH, nMonthH, nDateH, dDate) Then
    TheYomTovHeb = ToHebSt("TV BWBT")
  ElseIf IsPurimKatan(nYearH, nMonthH, nDateH, dDate) Then
    TheYomTovHeb = ToHebSt("PVRYm KTn")
  ElseIf IsShushanPurimKatan(nYearH, nMonthH, nDateH, dDate) Then
    TheYomTovHeb = ToHebSt("W""P KTn")
  ElseIf IsTaanisEsther(nYearH, nMonthH, nDateH, dDate) Then
    TheYomTovHeb = ToHebSt("XINYX ASXR")	
  ElseIf IsPurim(nYearH, nMonthH, nDateH, dDate) Then
    TheYomTovHeb = ToHebSt("PVRYm")
  ElseIf IsShushanPurim(nYearH, nMonthH, nDateH, dDate) Then
    TheYomTovHeb = ToHebSt("WVWn PVRYm")
  ElseIf IsPesachYT(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("PSJ")
  ElseIf IsPesachCH(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("JVH""M PSJ")
  ElseIf IsLagBOmer(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("L""G BIVMR")
  ElseIf IsShavuos(nYearH, nMonthH, nDateH) Then
    TheYomTovHeb = ToHebSt("WBVIVX")
  ElseIf Is17Tamuz(nYearH, nMonthH, nDateH, dDate) Then
    TheYomTovHeb = ToHebSt("Y""Z BXMVZ")
  ElseIf Is9BAv(nYearH, nMonthH, nDateH, dDate) Then
    TheYomTovHeb = ToHebSt("T' BAB")
  ElseIf Is15BAv(nYearH, nMonthH, nDateH, dDate) Then
    TheYomTovHeb = ToHebSt("T""V BAB")
  Else
    TheYomTovHeb = ""
  End If
End Function

Function Omer(nYearH As Long, nMonthH As Long, nDateH As Long) As Integer
  If nMonthH = 8 And nDateH >= 16 Then
    Omer = nDateH - 15
  ElseIf nMonthH = 9 Then
    Omer = nDateH + 15
  ElseIf nMonthH = 10 And nDateH < 6 Then
    Omer = nDateH + 44
  Else
    Omer = 0
  End If
End Function

Function TheYomTovGreg(dDate As Date) As String
  Dim nYearH As Long
  Dim nMonthH As Long
  Dim nDateH As Long
  
  GregToHeb dDate, nYearH, nMonthH, nDateH
  TheYomTovGreg = TheYomTov(nYearH, nMonthH, nDateH, dDate)
End Function

Function TheYomTovHebGreg(dDate As Date) As String
  Dim nYearH As Long
  Dim nMonthH As Long
  Dim nDateH As Long
  
  GregToHeb dDate, nYearH, nMonthH, nDateH
  TheYomTovHebGreg = TheYomTovHeb(nYearH, nMonthH, nDateH, dDate)
End Function

Function OmerGreg(dDate As Date)
  Dim nYearH As Long
  Dim nMonthH As Long
  Dim nDateH As Long
  
  GregToHeb dDate, nYearH, nMonthH, nDateH
  OmerGreg = Omer(nYearH, nMonthH, nDateH)
End Function

Function OmerDayNight(dDate As Date) As String
  Dim nOmer As Integer
  Dim nOmerN As Integer
  
  nOmerD = OmerGreg(dDate)
  nOmerN = OmerGreg(dDate + 1)
  
  If nOmerD <> 0 Then
    OmerDayNight = "Day: " + CStr(nOmerD)
    If nOmerD < 49 Then
      OmerDayNight = OmerDayNight + " "
    End If
  Else
    OmerDayNight = ""
  End If
  If nOmerN <> 0 Then
    OmerDayNight = OmerDayNight + "Night: " + CStr(nOmerN)
  End If
End Function

Private Function DaysBeforePesach(dWorkingShabbos, nYearH) As Integer
  Dim dErevPesach As Date
  dErevPesach = HebToGreg(nYearH, 8, 14)
  DaysBeforePesach = dErevPesach - dWorkingShabbos
End Function

Private Function DaysBeforeTishaBav(dWorkingShabbos, nYearH) As Integer
  Dim dTishaBav As Date
  dTishaBav = HebToGreg(nYearH, 12, 9)
  DaysBeforeTishaBav = dTishaBav - dWorkingShabbos
End Function

Private Function IsYomTov(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsYomTov = IsRoshHashana(nYearH, nMonthH, nDateH) Or _
             IsYomKippur(nYearH, nMonthH, nDateH) Or _
             IsSuccos(nYearH, nMonthH, nDateH) Or _
             IsPesach(nYearH, nMonthH, nDateH) Or _
             IsShavuos(nYearH, nMonthH, nDateH)

End Function

Private Function IsRoshHashana(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsRoshHashana = nMonthH = 1 And _
                  nDateH >= 1 And _
                  nDateH <= 2
End Function

Private Function IsYomKippur(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsYomKippur = nMonthH = 1 And _
                nDateH = 10
End Function

Private Function IsPesach(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsPesach = IsYomTovX(nYearH, nMonthH, nDateH, 8, 15, 7)
End Function

Private Function IsShavuos(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsShavuos = IsYomTovX(nYearH, nMonthH, nDateH, 10, 6, 1)
End Function

Private Function IsSuccos(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsSuccos = IsYomTovX(nYearH, nMonthH, nDateH, 1, 15, 8)
End Function

Private Function IsSuccosYT(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsSuccosYT = IsYomTovX(nYearH, nMonthH, nDateH, 1, 15, 1)
End Function

Private Function IsSuccosCH(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  If IsIsrael() Then
    IsSuccosCH = IsYomTovX(nYearH, nMonthH, nDateH, 1, 16, 5)
  Else
    IsSuccosCH = IsYomTovX(nYearH, nMonthH, nDateH, 1, 17, 3)
  End If
End Function

Private Function IsHoshanaRaba(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsHoshanaRaba = nMonthH = 1 And _
                  nDateH = 21
End Function


Function IsShminiAtzeres(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsShminiAtzeres = nMonthH = 1 And nDateH = 22 And Not IsIsrael()
End Function

Function IsSimchasTorah(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsSimchasTorah = nMonthH = 1 And nDateH = IIf(IsIsrael(), 22, 23)
End Function

Function IsRoshChodesh(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsRoshChodesh = nDateH = 1 Or nDateH = 30
End Function

Function IsChanukah(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  Dim nLengthOfYear As Integer
  Dim bHaser As Boolean
  
  If nMonthH = 3 And nDateH >= 25 Then
    IsChanukah = True
  ElseIf nMonthH = 4 Then
    nLengthOfYear = LengthOfYear(nYearH)
    bHaser = nLengthOfYear = 353 Or nLengthOfYear = 383
    IsChanukah = nDateH <= IIf(bHaser, 3, 2)
  Else
    IsChanukah = False
  End If
End Function

Function Is10Teves(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean
  Is10Teves = IsFastDay(nYearH, nMonthH, nDateH, dDate, 4, 10)
End Function

Function Is15Shevat(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean
  Is15Shevat = nMonthH = 5 And nDateH = 15
End Function

Function IsPurimKatan(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean
  IsPurimKatan = nMonthH = 6 And nDateH = 14
End Function

Function IsShushanPurimKatan(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean
  IsShushanPurimKatan = nMonthH = 6 And nDateH = 15
End Function

Function IsTaanisEsther(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean
  If nMonthH = 7 Then
    If nDateH = 13 Then
      IsTaanisEsther = Weekday(dDate) <> vbSaturday
    ElseIf nDateH = 11 Then ' the Thursday before if it comes out on Shabbos
      IsTaanisEsther = Weekday(dDate + 2) = vbSaturday
    End If
  End If
End Function

Function IsPurim(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean
  IsPurim = nMonthH = 7 And nDateH = 14
End Function

Function IsShushanPurim(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean
  IsShushanPurim = nMonthH = 7 And nDateH = 15
End Function

Private Function IsPesachYT(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsPesachYT = IsYomTovX(nYearH, nMonthH, nDateH, 8, 15, 1) Or _
               IsYomTovX(nYearH, nMonthH, nDateH, 8, 21, 1)
End Function

Private Function IsPesachCH(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  If IsIsrael() Then
    IsPesachCH = IsYomTovX(nYearH, nMonthH, nDateH, 8, 16, 5)
  Else
    IsPesachCH = IsYomTovX(nYearH, nMonthH, nDateH, 8, 17, 3)
  End If
End Function

Private Function IsLagBOmer(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean
  IsLagBOmer = nMonthH = 9 And _
                  nDateH = 18
End Function

Function Is17Tamuz(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean
  Is17Tamuz = IsFastDay(nYearH, nMonthH, nDateH, dDate, 11, 17)
End Function

Function Is9BAv(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean
  Is9BAv = IsFastDay(nYearH, nMonthH, nDateH, dDate, 12, 9)
End Function

Function Is15BAv(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean
  Is15BAv = nMonthH = 12 And _
            nDateH = 15
End Function

Function IsFastDay(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date, nMonthHX As Long, nDateHX As Long) As Boolean

  If nMonthH = nMonthHX Then
    If nDateH = nDateHX Then
      IsFastDay = Weekday(dDate) <> vbSaturday
    ElseIf nDateH = nDateHX + 1 Then
      IsFastDay = Weekday(dDate - 1) = vbSaturday
    End If
  End If
End Function

Private Function IsYomTovX(nYearH As Long, nMonthH As Long, nDateH As Long, nYTMonth, nYTDate, nYTLen) As Boolean
  Dim nEOYomTov As Integer
  nEOYomTov = nYTDate + nYTLen - 1
  If Not IsIsrael Then
    nEOYomTov = nEOYomTov + 1
  End If
  IsYomTovX = nMonthH = nYTMonth And _
              nDateH >= nYTDate And _
              nDateH <= nEOYomTov
End Function

Private Function InitWorkingShabbos(d As Date) As Date
  d = ShabbosOfDate(d)
  InitWorkingShabbos = ShabbosOfDate(PreviousSimchasTorah(d)) - 7
End Function

Private Function ShabbosOfDate(d As Date) As Date
  ShabbosOfDate = d + (7 - Weekday(d))
End Function

Private Function PreviousSimchasTorah(d As Date) As Date
  Dim nYearH As Long
  Dim nMonthH As Long
  Dim nDateH As Long
  Dim nSTDateH As Long
  
  GregToHeb d, nYearH, nMonthH, nDateH
  nSTDateH = IIf(IsIsrael, 22, 23)
  If nDateH < nSTDateH And nMonthH = 1 Then
    nYearH = nYearH - 1
  End If
  PreviousSimchasTorah = HebToGreg(nYearH, 1, nSTDateH)
End Function

Private Function IsIsrael() As Boolean
  IsIsrael = False
End Function



'''' DafAWeek and DafYomi Code '''' 



Function TheDafAWeekDaf(dDate As Date) As String
  Dim dStartDate As Date
  Dim nDafNum As Integer
  
  dStartDate = #3/6/2005#
  dDate = Int(dDate)
  dDate = dDate - (Weekday(dDate) - 1) ' force the date to Sunday
  nDafNum = (dDate - dStartDate) / 7
  TheDafAWeekDaf = TheDafX(nDafNum)
End Function

Function TheDafYomiDaf(dDate As Date) As String
  Dim dStartDate As Date
  Dim nDafNum As Integer
  
  dStartDate = #3/2/2005#
  dDate = Int(dDate)
  nDafNum = dDate - dStartDate
  TheDafYomiDaf = TheDafX(nDafNum)
End Function

Function GetaGemara()
  ReDim aGemara(36, 4)

  PutGemara aGemara, 0, "BRCVX", 64, False, "Berachos"
  PutGemara aGemara, 1, "WBX", 157, True, "Shabbos"
  PutGemara aGemara, 2, "IRVBYn", 105, False, "Eruvin"
  PutGemara aGemara, 3, "PSJYm", 121, True, "Pesachim"
  PutGemara aGemara, 4, "WKLYm", 22, True, "Shekalim"
  PutGemara aGemara, 5, "YVMA", 88, False, "Yoma"
  PutGemara aGemara, 6, "SVCH", 56, True, "Sukah"
  PutGemara aGemara, 7, "BYQH", 40, True, "Beitzah"
  PutGemara aGemara, 8, "RAW HWNH", 35, True, "Rosh Hash."
  PutGemara aGemara, 9, "XINYX", 31, False, "Taanis"
  PutGemara aGemara, 10, "MGYLH", 32, False, "Megilah"
  PutGemara aGemara, 11, "MVID KTn", 29, False, "Moed Katan"
  PutGemara aGemara, 12, "JGYGH", 27, False, "Chagigah"
  PutGemara aGemara, 13, "YBMVX", 122, True, "Yevamos"
  PutGemara aGemara, 14, "CXVBVX", 112, True, "Kasuvos"
  PutGemara aGemara, 15, "NDRYm", 91, True, "Nedarim"
  PutGemara aGemara, 16, "NZYR", 66, True, "Nazir"
  PutGemara aGemara, 17, "SVTH", 49, True, "Sotah"
  PutGemara aGemara, 18, "GYTYn", 90, True, "Gitin"
  PutGemara aGemara, 19, "KDVWYn", 82, True, "Kidushin"
  PutGemara aGemara, 20, "BBA KMA", 119, True, "Bava Kama"
  PutGemara aGemara, 21, "BBA MQYIA", 119, False, "Bava Mitz"
  PutGemara aGemara, 22, "BBA BXRA", 176, True, "Bava Basra"
  PutGemara aGemara, 23, "SNHDRYn", 113, True, "Sanhedrin"
  PutGemara aGemara, 24, "MCVX", 24, True, "Makos"
  PutGemara aGemara, 25, "WBVIVX", 49, True, "Shevuos"
  PutGemara aGemara, 26, "IBVDH ZRH", 76, True, "Avoda Zora"
  PutGemara aGemara, 27, "HVRYVX", 14, False, "Harayos"
  PutGemara aGemara, 28, "ZBJYm", 120, True, "Zevachim"
  PutGemara aGemara, 30, "JVLYn", 142, False, "Chulin"
  PutGemara aGemara, 31, "BCVRVX", 61, False, "Bechoros"
  PutGemara aGemara, 32, "IRCYn", 34, False, "Erchin"
  PutGemara aGemara, 33, "XMVRVX", 34, False, "Temurah"
  PutGemara aGemara, 34, "CRYXVX", 28, True, "Kerisus"
  PutGemara aGemara, 35, "MIYLH ...", 37, True, "Meilah etc."
  PutGemara aGemara, 36, "NYDH", 73, False, "Nida"
  
  GetaGemara = aGemara
End Function

Sub PutGemara(ByRef aGemara, n As Integer, sHebSt As String, nPages As String, bHasAmudB As Boolean, sName As String)
  aGemara(n, 0) = ToHebSt(sHebSt)
  aGemara(n, 1) = nPages
  aGemara(n, 2) = bHasAmudB
  If n = 0 Then
    aGemara(n, 3) = 0
  Else
    aGemara(n, 3) = (aGemara(n - 1, 1) - 1) + aGemara(n - 1, 3)
  End If
  aGemara(n, 4) = sName
End Sub

Function TheDafX(ByVal nDafNum As Integer)
  Dim nRow As Integer
  Dim nDafInMesechta As Integer
  Dim nTheDafX As Double
  Dim sMesechta As String
  Dim sTheDaf As String
  Dim nTotalDafs As Integer
  Dim nTheDaf As Double
  Dim bShowAmud As Boolean
  Dim nHowManyDaf As Double
  
  Dim aGemara
  Dim n As Integer
  
  aGemara = GetaGemara
  nDafNum = nDafNum Mod 2711
  n = 0
  Do While True
    nDafInMesechta = aGemara(n, 1) - 1
    If nDafNum < nDafInMesechta Then
      Exit Do
    End If
    nDafNum = nDafNum - nDafInMesechta
    n = n + 1
  Loop
  nTheDaf = nDafNum + 2
  sMesechta = aGemara(n, 0)
  sTheDaf = HebrewNum(nTheDaf)
  ' To use english letters
  ' sMesechta = aGemara(n, 4)
  ' sTheDaf = CStr(nTheDaf)
  TheDafX = sMesechta & " " & sTheDaf
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetGemaraName(n As Integer) As String
  Dim aGemara
  aGemara = GetaGemara
  GetGemaraName = aGemara(n, 0)
End Function

Function GetGemaraPages(n As Integer) As Integer
  Dim aGemara
  aGemara = GetaGemara
  GetGemaraPages = aGemara(n, 1)
End Function

Function GetGemaraHasAmudB(n As Integer) As Boolean
  Dim aGemara
  aGemara = GetaGemara
  GetGemaraHasAmudB = aGemara(n, 2)
End Function

Function GetGemaraOffset(n As Integer) As Integer
  Dim aGemara
  aGemara = GetaGemara
  GetGemaraOffset = aGemara(n, 3)
End Function

' takes a cell that's in Hebrew and returns the HebSt value
Function HebCellToHebSt(nCellY As Long, nCellX As Long) As String
  Dim n As Integer
  Dim sCh As String
  Dim sHebCh As String
  sToHebSt = Cells(nCellY, nCellX).Value
  For n = 1 To Len(sToHebSt)
    sCh = Mid(sToHebSt, n, 1)
    Select Case sCh
      Case ChrW(1488) ' Alef
        sToHebCh = "A"
      Case ChrW(1489) ' Beis
        sToHebCh = "B"
      Case ChrW(1490) ' Gimmel
        sToHebCh = "G"
      Case ChrW(1491) ' Daled
        sToHebCh = "D"
      Case ChrW(1492) ' Hay
        sToHebCh = "H"
      Case ChrW(1493) ' Vav
        sToHebCh = "V"
      Case ChrW(1494) ' Ziyen
        sToHebCh = "Z"
      Case ChrW(1495) ' Ches
        sToHebCh = "J"
      Case ChrW(1496) ' Tes
        sToHebCh = "T"
      Case ChrW(1497) ' Yud
        sToHebCh = "Y"
      Case ChrW(1498) ' cuff Sofit
        sToHebCh = "c"
      Case ChrW(1499) ' Cuff
        sToHebCh = "C"
      Case ChrW(1500) ' Lamed
        sToHebCh = "L"
      Case ChrW(1501) ' Mem Sofit
        sToHebCh = "m"
      Case ChrW(1502) ' Mem
        sToHebCh = "M"
      Case ChrW(1503) ' Nun Sofit
        sToHebCh = "n"
      Case ChrW(1504) ' Nun
        sToHebCh = "N"
      Case ChrW(1505) ' Samech
        sToHebCh = "S"
      Case ChrW(1506) ' Iyin
        sToHebCh = "I"
      Case ChrW(1507) ' Pei Sofit
        sToHebCh = "p"
      Case ChrW(1508) ' Pei
        sToHebCh = "P"
      Case ChrW(1509) ' Tzadi Sofit
        sToHebCh = "q"
      Case ChrW(1510) ' Tzadi
        sToHebCh = "Q"
      Case ChrW(1511) ' Koof
        sToHebCh = "K"
      Case ChrW(1512) ' Reish
        sToHebCh = "R"
      Case ChrW(1513) ' Shin
        sToHebCh = "W"
      Case ChrW(1514) ' Tuff
        sToHebCh = "X"
      Case Else
        sToHebCh = sCh
    End Select
    FromHebSt = FromHebSt & sToHebCh
  Next
End Function

Sample Code VB.Net

Sample HTML/Java Script Code

Return to Daf-A-Week