VB.Net Special Dates

Get UK Bank Holidays

This is the "default" set of bank holidays. Uk bank holiday dates will often change due events of national importance etc.

Public Function BankHolidaysUK(yyyy As Integer) As Dictionary(Of Integer, String)
 Dim dat, christmasDay, boxingDay As Date
 Dim dictBank As Dictionary(Of Integer, String) = New Dictionary(Of Integer, String)
 dictBank.Clear()
 ' New Year Bank Holiday = first weekday on or after 1st January
 dat = New Date(yyyy, 1, 1)
 While IsWeekend(dat) : dat = dat.AddDays(1) : End While
 AddToDictBank(dat, "New Years Day Bank Holiday")
 ' May Day = first Monday on or after 1st May 
 AddToDictBank(FirstMonday("first", "monday", (yyyy * 100) + 5), "May Day Bank Holiday")
 ' Spring = last Monday on or before 31st May
 AddToDictBank(FirstMonday("last", "monday", (yyyy * 100) + 3), "Spring Bank Holiday")
 ' Summer = last Monday on or before 31st August
 AddToDictBank(FirstMonday("last", "monday", (yyyy * 100) + 8), "Summer Bank Holiday")
 ' Good Friday and Easter Monday are based on the Western Easter Date 
 AddToDictBank(Easter(yyyy).AddDays(-2), "Good Friday Bank Holiday")
 AddToDictBank(Easter(yyyy).AddDays(1), "Easter Monday Bank Holiday")
 ' Christmas and Boxing Day (Bank Holidays must be on a weekday)
 dat = New Date(yyyy, 12, 25)
 If dat.DayOfWeek = DayOfWeek.Friday Then
  christmasDay = New Date(yyyy, 12, 25) : AddToDictBank(christmasDay, "Christmas Day Bank Holiday")
  boxingDay = New Date(yyyy, 12, 28) : AddToDictBank(boxingDay, "Boxing Day Bank Holiday")
 End If
 If dat.DayOfWeek = DayOfWeek.Saturday Then
  christmasDay = New Date(yyyy, 12, 27) : AddToDictBank(christmasDay, "Christmas Day Bank Holiday")
  boxingDay = New Date(yyyy, 12, 28) : AddToDictBank(boxingDay, "Boxing Day Bank Holiday")
 End If
 If dat.DayOfWeek = DayOfWeek.Sunday Then
  christmasDay = New Date(yyyy, 12, 27) : AddToDictBank(christmasDay, "Christmas Day Bank Holiday")
  boxingDay = New Date(yyyy, 12, 26) : AddToDictBank(boxingDay, "Boxing Day Bank Holiday")
 End If
 If ((dat.DayOfWeek = DayOfWeek.Monday) Or (dat.DayOfWeek = DayOfWeek.Tuesday) Or (dat.DayOfWeek = DayOfWeek.Wednesday) Or (dat.DayOfWeek = DayOfWeek.Thursday)) Then
  christmasDay = New Date(yyyy, 12, 25) : AddToDictBank(christmasDay, "Christmas Day Bank Holiday")
  boxingDay = New Date(yyyy, 12, 26) : AddToDictBank(boxingDay, "Boxing Day Bank Holiday")
 End If
 Return dictBank
End Function

Get 1st,2nd,...Last "day-of-week" for any month

Public Function FirstMonday(first As String, monday As String, yyyymm As Integer) As Date
 ' returns the first/second/third/forth/last occurence for any day_of_week in any month of any year 
 Dim dayWeek As DayOfWeek
 Dim dd, mm, yyyy As Integer
 yyyy = CInt((Int(yyyymm / 100)) Mod 10000)
 mm = yyyymm Mod 100
 first = Trim(LCase(first)) + "  "
 first = Mid(first, 1, 2)
 monday = Trim(LCase(monday)) + "  "
 monday = Mid(monday, 1, 2)
 Select Case first
  Case "fi" : dd = 1 ' first
  Case "se" : dd = 8 ' second
  Case "th" : dd = 15 ' third
  Case "fo" : dd = 22 ' forth
  Case "la" : dd = 31 ' last
  Case Else : dd = 1 : first = "fi"
 End Select
 dayWeek = TextToDayOfWeek(monday)
 If first = "la" Then
  dd = Date.DaysInMonth(yyyy, mm)
  Dim dat As Date = New Date(yyyy, mm, dd)
  While dat.DayOfWeek <> dayWeek
   dat = DateAdd(DateInterval.Day, -1, dat)
  End While
 Else
  Dim dat As Date = New Date(yyyy, mm, dd)
  While dat.DayOfWeek <> dayWeek
   dat = DateAdd(DateInterval.Day, 1, dat)
  End While
 End If
 Return dat 
End Function

Does date fall on a weekday

Public Function IsWeekday(dat As Date) As Boolean
 Dim answer As Boolean = True
 If ((dat.DayOfWeek = DayOfWeek.Saturday) Or (dat.DayOfWeek = DayOfWeek.Sunday)) Then answer = False
 Return answer
End Function

Does date fall on a weekend

Public Function IsWeekend(dat As Date) As Boolean
 Dim answer As Boolean = False
 If ((dat.DayOfWeek = DayOfWeek.Saturday) Or (dat.DayOfWeek = DayOfWeek.Sunday)) Then answer = True
 Return answer
End Function

Convert WeekdayName to DayOfWeek

Private Function TextToDayOfWeek(text As String) As DayOfWeek
 Dim DoW As DayOfWeek
 text = Mid(text & "   ", 1, 2).ToLower
 Select Case text
  Case "su" : DoW = DayOfWeek.Sunday
  Case "mo" : DoW = DayOfWeek.Monday
  Case "tu" : DoW = DayOfWeek.Tuesday
  Case "we" : DoW = DayOfWeek.Wednesday
  Case "th" : DoW = DayOfWeek.Thursday
  Case "fr" : DoW = DayOfWeek.Friday
  Case Else : DoW = DayOfWeek.Saturday
 End Select
 Return DoW
End Function

Get Date of Easter Sunday

Public Function Easter(yyyy As Integer) As Date
' Get date for Western Easter (assume Gregorian calendar) for any year after 1600
 Dim a, b, c, d, e, f, g, h, i, k, l, m, mm, dd As Integer
 a = yyyy Mod 19
 b = yyyy \ 100
 c = yyyy Mod 100
 d = b \ 4
 e = b Mod 4
 f = (b + 8) \ 25
 g = (b - f + 1) \ 3
 h = (19 * a + b - d - g + 15) Mod 30
 i = c \ 4
 k = c Mod 4
 l = (32 + 2 * e + 2 * i - h - k) Mod 7
 m = (a + 11 * h + 22 * l) \ 451
 mm = (h + l - 7 * m + 114) \ 31
 dd = ((h + l - 7 * m + 114) Mod 31) + 1
 Return New Date(yyyy, mm, dd, 12, 0, 0, 0)
End Function

Get Date of Orthodox Easter

Public Function OrthodoxEaster(yyyy As Integer) As Date
 ' This date rarely matches Western Easter (normal UK Easter)
 ' That date is calculated using teh above Easter function
 Dim r1, r2, r3, r4, r5, ra, rb, rc As Integer
 Dim Jul2Greg As Integer
 r1 = yyyy Mod 19
 r2 = yyyy Mod 4
 r3 = yyyy Mod 7
 ra = 19 * r1 + 16
 r4 = ra Mod 30
 rb = 2 * r2 + 4 * r3 + 6 * r4
 r5 = rb Mod 7
 rc = r4 + r5
 Dim eDate As New Date(yyyy, 3, 21)
 eDate = DateAdd(DateInterval.Day, rc, eDate)
 Jul2Greg = CInt(Int((Int(yyyy \ 100) * 3) / 4) - 2)
 eDate = DateAdd(DateInterval.Day, Jul2Greg, eDate)
 Return eDate
End Function

Get Date for Rosh Hashhannah

Public Function RoshHashhanah(yyyy As Integer) As Date
 ' this is completely untested - does anyone know if it works
 ' Caution - Days in Hebrew calendar start at sun-down (NOT midnight) 
 Dim g As Integer = (yyyy Mod 19) + 1
 Dim g12 As Integer = g * 12
 Dim mm, dd As Integer
 Dim rosh As Date
 Dim wd As System.DayOfWeek
 Dim a As Double, frac As Double
 a = (Math.Floor(yyyy / 100) - Math.Floor(yyyy / 400) - 2) + (765433 / 492480 * (g12 Mod 19)) + ((yyyy Mod 4) / 4) - (((313 * yyyy) + 89081) / 98496)
 mm = 9
 dd = CInt(Math.Floor(a))
 If dd > 30 Then
  dd -= 30
  mm += 1
 End If
 rosh = New Date(yyyy, mm, dd)
 wd = rosh.DayOfWeek
 If ((wd = DayOfWeek.Sunday) Or (wd = DayOfWeek.Wednesday) Or (wd = DayOfWeek.Friday)) Then
  rosh = rosh.AddDays(1)
 End If
 If (wd = DayOfWeek.Monday) Then
  frac = Math.Floor(a)
  If (frac > (23269 / 25920)) Then
   If (g12 Mod 19) > 11 Then
    rosh = rosh.AddDays(1)
   End If
  End If
 End If
 If wd = DayOfWeek.Tuesday Then
  frac = a - Math.Floor(a)
  If (frac > (1367 / 2160)) Then
   If ((g12 Mod 19) > 6) Then
    rosh = rosh.AddDays(2)
   End If
  End If
 End If
 Return rosh
End Function

Convert MonthName to MonthNumber

Public Function TextToMonth(month As String) As Integer
 Dim i, mm As Integer
 month = Mid(Trim(month) & "   ", 1, 3).ToLower
 Dim temp As String = "000,jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec)"
 Dim names() As String = Split(temp, ",")
 mm = 1
 For i = 1 To 12
  If month = names(i) Then mm = i : Exit For
 Next
 Return mm
End Function

Get ISO Week Number

This is the standard ISO week number. Many apps invent their own non-standard week numbering conventions.

Public Function WeekNumber(dat As Date) As Integer
 ' week 1 starts on the monday proceeding first thursday of the year
 ' this is the ISO definition - The VB weekOfYear feature is not iso compliant
 ' calculate date of Monday on Week 0 (this is in previous year!)
 Dim ww, yyyy As Integer
 Dim firstThursday, mondayWeek0 As Date
 yyyy = dat.Year
 firstThursday = FirstMonday("first", "Thursday", (yyyy * 100) + 1)
 mondayWeek0 = DateAdd(DateInterval.Day, -11, firstThursday)
 ' calculate number of weeks after start of week 0
 ww = CInt(DateDiff(DateInterval.Day, mondayWeek0, dat))
 ww = CInt(Int(ww / 7))
 Return ww
End Function

Find nearest DayOfWeek to any date

Public Function NearestToDate(dat As Date, weekday As DayOfWeek) As Date
 dat = DateAdd(DateInterval.Day, -3, dat)
 While dat.DayOfWeek <> weekday
  dat = DateAdd(DateInterval.Day, 1, dat)
 End While
 Return dat
End Function

The code functions on this site are only intended as a learning aid. Data validation is often ommited to assist users unfamiliar with Visual Basic. The information may be untested, unrelaible or unsuitable for your requiremensts. It is presented in a non-commercial form as an ex-gratia attempt to be helpful. By making any use of information contained on these pages, you agree to fully absolve and indemnify DigitalDan in relation to any issue arising out of such use.