gcfrench: Vague dates

Vague dates

This page will contain useful functions for managing vague dates

Table of Contents

'Written by Graham French, NBN Trust September 2008 and is supplied as is, these functions have not been extensively checked. Please check that they are converting dates to the correct vague date. Send any comments to ku.gro.nbn|atad#ku.gro.nbn|atad
'WORKS IN MICROSOFT ACCESS AND EXCEL

Get Start Date

'This function formats DD MMM YYYY, MMM YYYY, YYYY, SEASON YYYY,00/MM/YYYY, DD/MM/YYYY-DD/MM/YYYY dates into start dates for NBN Exchange Format
'FORMATS DD MMM YYYY, MMM YYYY, YYYY, SEASON YYYY, 00/MM/YYYY, DD/MM/YYYY-DD/MM/YYYY DATES INTO START DATES FOR NBN EXCHANGE FORMAT

Public Function NBN_Get_Start_Date(unformattedDate As Variant) As Variant

Dim sDate As Variant
Dim sDay As String, sMonth As String, sYear As String

'CHECK FOR FORMATTED OR NULL DATE
If InStr(1, unformattedDate, "/") Or IsNull(unformattedDate) Then
   'CHECK FOR 00/ DATE
   If Left(unformattedDate, 3) = "00/" Then
      sYear = Right(unformattedDate, 4)
      Select Case Mid(unformattedDate, 4, 2)
        Case Is = "00"
         unformattedDate = sYear
        Case Is = "01"
         unformattedDate = "JAN " & sYear
        Case Is = "02"
         unformattedDate = "FEB " & sYear
        Case Is = "03"
         unformattedDate = "MAR " & sYear
        Case Is = "04"
         unformattedDate = "APR " & sYear
        Case Is = "05"
         unformattedDate = "MAY " & sYear
        Case Is = "06"
         unformattedDate = "JUN " & sYear
        Case Is = "07"
         unformattedDate = "JUL " & sYear
        Case Is = "08"
         unformattedDate = "AUG " & sYear
        Case Is = "09"
         unformattedDate = "SEP " & sYear
        Case Is = "10"
         unformattedDate = "OCT " & sYear
        Case Is = "11"
         unformattedDate = "NOV " & sYear
        Case Is = "12"
         unformattedDate = "DEC " & sYear
       End Select
    'CHECK FOR DD/MM/YYYY-DD/MM/YYYY
    ElseIf Len(unformattedDate) = 21 Then
       unformattedDate = Left(unformattedDate, 10)
       NBN_Get_Start_Date = unformattedDate
       Exit Function
    Else
     NBN_Get_Start_Date = unformattedDate
     Exit Function
  End If
End If

'CHECK FOR - AT BEGINNING OF DATE EG "- YYYY"
If Left(unformattedDate, 1) = "-" Then
  Exit Function
End If

'CHECK FOR " - " IN MIDDLE OF DATE EG "DD MMM YYYY - DD MMM YYYY"
If InStr(1, unformattedDate, " - ", vbTextCompare) Then
   sDate = Split(unformattedDate, " - ")
   unformattedDate = sDate(0)
End If

'CHECK FOR UNKNOWN DATE
If unformattedDate = "unknown" Then
  Exit Function
End If

'SPLIT UNFORMATTED DATE INTO ARRAY
sDate = Split(unformattedDate, " ")

'SET DEFAULT DAY, MONTH, YEAR
sDay = "00"
sMonth = "00"
sYear = "0000"

Select Case UBound(sDate)
   Case Is = 0 'YYYY
        If Len(sDate(0)) = 4 Then 'CONFIRMED YEAR
            sDay = "01"
            sMonth = "01"
            sYear = sDate(0)
        End If
    Case Is = 1 'MMM YYYY
         'CONVERT SEASON TO MONTH or SEASON YYYY
        If Is_Season(CStr(sDate(0))) = True Then
            Select Case sDate(0)
               Case Is = "Spring"
                  sDate(0) = "MAR"
               Case Is = "Summer"
                  sDate(0) = "JUN"
               Case Is = "Autumn"
                  sDate(0) = "SEP"
               Case Is = "Winter"
                  sDate(0) = "DEC"
            End Select
        End If
        If Len(sDate(0)) + Len(sDate(1)) = 7 Then 'CONFIRMED MMM YYYY
            sDay = "01"
            sMonth = Get_Month(CStr(sDate(0)))
            sYear = sDate(1)
        End If
    Case Is = 2 'DD MMM YYYY
        If Len(sDate(0)) + Len(sDate(1)) + Len(sDate(2)) = 9 Then   'CONFIRMED DD MM YYYY
            sDay = sDate(0)
            sMonth = Get_Month(CStr(sDate(1)))
            sYear = sDate(2)
        End If
End Select

If sDay <> "00" Or sMonth <> "00" Or sYear <> "0000" Then
'FORMAT STARTDATE
    NBN_Get_Start_Date = sDay & "/" & sMonth & "/" & sYear
Else
'RETURN UNKNOWN
    NBN_Get_Start_Date = "UnidentifiedFormat"
End If

End Function

NBN_Get End Date

'This function formats DD MMM YYYY, MMM YYYY, YYYY, SEASON YYYY,00/MM/YYYY, DD/MM/YYYY-DD/MM/YYYY dates into end dates for NBN Exchange Format
'FORMATS DD MMM YYYY, MMM YYYY, YYYY, SEASON YYYY,00/MM/YYYY, DD/MM/YYYY-DD/MM/YYYY DATES INTO END DATES FOR NBN EXCHANGE FORMAT
'Returns 'UnidentifedFormat' if date format not above

Public Function NBN_Get_End_Date(unformattedDate As Variant) As Variant

Dim sDate As Variant
Dim sDay As String, sMonth As String, sYear As String

'CHECK FOR FORMATTED OR NULL DATE
If InStr(1, unformattedDate, "/") Or IsNull(unformattedDate) Then
   'CHECK FOR 00/ DATE
   If Left(unformattedDate, 3) = "00/" Then
      sYear = Right(unformattedDate, 4)
      Select Case Mid(unformattedDate, 4, 2)
        Case Is = "00"
         unformattedDate = sYear
        Case Is = "01"
         unformattedDate = "JAN " & sYear
        Case Is = "02"
         unformattedDate = "FEB " & sYear
        Case Is = "03"
         unformattedDate = "MAR " & sYear
        Case Is = "04"
         unformattedDate = "APR " & sYear
        Case Is = "05"
         unformattedDate = "MAY " & sYear
        Case Is = "06"
         unformattedDate = "JUN " & sYear
        Case Is = "07"
         unformattedDate = "JUL " & sYear
        Case Is = "08"
         unformattedDate = "AUG " & sYear
        Case Is = "09"
         unformattedDate = "SEP " & sYear
        Case Is = "10"
         unformattedDate = "OCT " & sYear
        Case Is = "11"
         unformattedDate = "NOV " & sYear
        Case Is = "12"
         unformattedDate = "DEC " & sYear
       End Select
    'CHECK FOR DD/MM/YYYY-DD/MM/YYYY
    ElseIf Len(unformattedDate) = 21 Then
       unformattedDate = Right(unformattedDate, 10)
       NBN_Get_End_Date = unformattedDate
       Exit Function
    Else
     NBN_Get_End_Date = unformattedDate
     Exit Function
  End If
End If

'CHECK FOR - IN DATE EG - YYYY
If Left(unformattedDate, 1) = "-" Then
  unformattedDate = Right(unformattedDate, 4)
End If

'CHECK FOR " - " IN MIDDLE OF DATE EG "DD MMM YYYY - DD MMM YYYY"
If InStr(1, unformattedDate, " - ", vbTextCompare) Then
   sDate = Split(unformattedDate, " - ")
   unformattedDate = sDate(1)
End If

'CHECK FOR UNKNOWN DATE
If unformattedDate = "unknown" Then
  Exit Function
End If

'SPLIT UNFORMATTED DATE INTO ARRAY
sDate = Split(unformattedDate, " ")

'SET DEFAULT DAY, MONTH, YEAR
sDay = "00"
sMonth = "00"
sYear = "0000"

Select Case UBound(sDate)
   Case Is = 0 'YYYY
        If Len(sDate(0)) = 4 Then 'CONFIRMED YEAR
            sDay = "31"
            sMonth = "12"
            sYear = sDate(0)
        End If
    Case Is = 1 'MMM YYYY or SEASON YYYY
        'CONVERT SEASON TO MONTH
        If Is_Season(CStr(sDate(0))) = True Then
            Select Case sDate(0)
               Case Is = "Spring"
                  sDate(0) = "MAY"
               Case Is = "Summer"
                  sDate(0) = "AUG"
               Case Is = "Autumn"
                  sDate(0) = "NOV"
               Case Is = "Winter"
                  sDate(0) = "FEB"
            End Select
        End If
        If Len(sDate(0)) + Len(sDate(1)) = 7 Then 'CONFIRMED MMM YYYY
            sDay = Get_End_Day(CStr(sDate(0)), CInt(sDate(1)))
            sMonth = Get_Month(CStr(sDate(0)))
            sYear = sDate(1)
        End If
    Case Is = 2 'DD MMM YYYY
        If Len(sDate(0)) + Len(sDate(1)) + Len(sDate(2)) = 9 Then   'CONFIRMED DD MM YYYY
            sDay = sDate(0)
            sMonth = Get_Month(CStr(sDate(1)))
            sYear = sDate(2)
        End If
End Select

If sDay <> "00" Or sMonth <> "00" Or sYear <> "0000" Then
'FORMAT STARTDATE
    NBN_Get_End_Date = sDay & "/" & sMonth & "/" & sYear
Else
'RETURN UNKNOWN
    NBN_Get_End_Date = "UnidentifiedFormat"
End If

End Function

Private Function Get_Month(sMonth As String) As String

Dim MonthNumber As String

Select Case UCase(sMonth)
   Case Is = "JAN"
     MonthNumber = "01"
   Case Is = "FEB"
     MonthNumber = "02"
   Case Is = "MAR"
     MonthNumber = "03"
   Case Is = "APR"
     MonthNumber = "04"
   Case Is = "MAY"
     MonthNumber = "05"
   Case Is = "JUN"
     MonthNumber = "06"
   Case Is = "JUL"
     MonthNumber = "07"
   Case Is = "AUG"
     MonthNumber = "08"
   Case Is = "SEP"
     MonthNumber = "09"
   Case Is = "OCT"
     MonthNumber = "10"
   Case Is = "NOV"
     MonthNumber = "11"
   Case Is = "DEC"
     MonthNumber = "12"
   Case Else
     MonthNumber = "00"
End Select

Get_Month = MonthNumber

End Function

Private Function Get_End_Day(sMonth As String, sYear As Integer) As String

Dim DayNumber As String

Select Case UCase(sMonth)
   Case Is = "JAN"
     DayNumber = "31"
   Case Is = "FEB"
     Select Case Is_Leap_Year(sYear)
        Case Is = True
          DayNumber = "29"
        Case Is = False
          DayNumber = "28"
     End Select
   Case Is = "MAR"
     DayNumber = "31"
   Case Is = "APR"
     DayNumber = "30"
   Case Is = "MAY"
     DayNumber = "31"
   Case Is = "JUN"
     DayNumber = "30"
   Case Is = "JUL"
     DayNumber = "31"
   Case Is = "AUG"
     DayNumber = "31"
   Case Is = "SEP"
     DayNumber = "30"
   Case Is = "OCT"
     DayNumber = "31"
   Case Is = "NOV"
     DayNumber = "30"
   Case Is = "DEC"
     DayNumber = "31"
   Case Else
     DayNumber = "00"
End Select

Get_End_Day = DayNumber

End Function

Private Function Is_Leap_Year(sYear As Integer) As Boolean

Dim LeapYear As Boolean
LeapYear = False

' CHECK IF YEAR IS DIVISIBLE BY 4
If sYear Mod 4 = 0 Then
' CHECK IF YEAR IS DIVISIBLE BY 100 AND ALSO 400
    Select Case sYear Mod 100
        Case Is <> 0
            LeapYear = True
        Case Is = 0
            If sYear Mod 400 = 0 Then
                LeapYear = True
            End If
    End Select
End If

Is_Leap_Year = LeapYear

End Function

Private Function Is_Season(sDate As String) As Boolean

Dim bSeason As Boolean
bSeason = False

Select Case UCase(sDate)
   Case Is = "SPRING"
      bSeason = True
   Case Is = "SUMMER"
      bSeason = True
   Case Is = "AUTUMN"
      bSeason = True
   Case Is = "WINTER"
      bSeason = True
End Select

Is_Season = bSeason

End Function

'Written by Graham French, NBN Trust September 2008 and is supplied as is, these functions have not been extensively checked. Please check that they are converting vague dates to the correct date type. Send any comments to ku.gro.nbn|atad#ku.gro.nbn|atad
'WORKS IN MICROSOFT ACCESS AND EXCEL (in ACCESS replace IsEmpty function with IsNull function)

Get Date Type

' DATES MUST BE "NULL", "DD/MM/YYYY" or "DD MMM YYYY" Format
' WORKS IN MICROSOFT ACCESS AND EXCEL

Public Function NBN_Get_Date_Type(startDate As Variant, endDate As Variant) As String

Dim sDateType As String
Dim sStartDate As String
Dim sEndDate As String
Dim iDateDiff As Integer

'SET DATETYPE AS UNKNOWN
sDateType = "Invalid Date"

'CHECK VALID DATE FORMAT
If Valid_Date_Format(startDate) = False Or Valid_Date_Format(endDate) = False Then
NBN_Get_Date_Type = sDateType
Exit Function
End If

'NULL DATES = UNKNOWN DATE
If IsNull(startDate) And IsNull(endDate) Then
sDateType = "ND"
NBN_Get_Date_Type = sDateType
Exit Function
End If

'END YEAR ONLY KNOWN
If IsNull(startDate) And Not IsNull(endDate) Then
If End_Of_Year(CStr(endDate)) = True Then
sDateType = "-Y"
NBN_Get_Date_Type = sDateType
Exit Function
Else
'NO DATE (ENDDATE ONLY GIVEN BUT NOT END YEAR)
sDateType = "Invalid Date Type"
NBN_Get_Date_Type = sDateType
Exit Function
End If
End If

'CONVERT DATES TO "DD/MM/YYYY" (in Excel use WorksheetFunction.Text(DATE, "dd/mm/yyyy")
sStartDate = DateValue(startDate)
sEndDate = DateValue(endDate)

'CALCULATES DATE DIFF
iDateDiff = DateDiff("d", sStartDate, sEndDate) + 1

'SETS DATE TYPE

Select Case iDateDiff
Case Is = 1
'DAY
sDateType = "D"
Case 2 To 27
'NUMBER OF DAYS
sDateType = "DD"
Case 28 To 31
If Start_Of_Month(sStartDate) = True And End_Of_Month(sEndDate) = True Then
'MONTH
sDateType = "O"
Else
'NUMBER OF DAYS
sDateType = "DD"
End If
Case 32 To 364
If Same_Year(sStartDate, sEndDate) = True Then
If Start_Of_Month(sStartDate) = True And End_Of_Month(sEndDate) = True Then
'NUMBER OF MONTHS
sDateType = "OO"
Else
'NUMBER OF DAYS
sDateType = "DD"
End If
Else
'NUMBER OF DAYS
sDateType = "DD"
End If
Case Is >= 365
If Same_Year(sStartDate, sEndDate) Then
'YEAR
sDateType = "Y"
Else
If Start_Of_Year(sStartDate) = True And End_Of_Year(sEndDate) = True Then
'NUMBER OF YEARS
sDateType = "YY"
Else
'NUMBER OF DAYS
sDateType = "DD"
End If
End If
End Select

NBN_Get_Date_Type = sDateType

End Function

Private Function Valid_Date_Format(vDate As Variant) As Boolean

Dim ValidFormat As Boolean
Dim day As Integer
Dim month As Integer
ValidFormat = False

'NULL DATE
If IsEmpty(vDate) = True Then
ValidFormat = True
Valid_Date_Format = ValidFormat
Exit Function
End If

'VALID DATE
If IsDate(vDate) Then
Select Case Len(vDate)
'DD/MM/YYYY
Case Is = 10
'CHECK DAY
If Mid(vDate, 3, 1) = "/" And Mid(vDate, 6, 1) = "/" Then
 day = Left(vDate, 2)
 month = Mid(vDate, 4, 2)
 If day > 31 Then
   ValidFormat = False
   Valid_Date_Format = ValidFormat
 End If
 'CHECK MONTH
 If month > 12 Then
   ValidFormat = False
   Valid_Date_Format = ValidFormat
   Exit Function
 End If
 ValidFormat = True
 Valid_Date_Format = ValidFormat
End If
Case Is = 11
'DD MMM YYYY
If Mid(vDate, 3, 1) = " " And Mid(vDate, 7, 1) = " " Then
ValidFormat = True
Valid_Date_Format = ValidFormat
'Exit Function
End If
End Select
End If

Valid_Date_Format = ValidFormat

End Function

Private Function End_Of_Month(sDate As String) As Boolean

Dim MonthEnd As Boolean
MonthEnd = False

Select Case DatePart("m", sDate)
'JANUARY, MARCH, MAY, JULY, AUGUST, OCTOBER, DECEMBER
Case 1, 3, 5, 7, 8, 10, 12
If DatePart("d", sDate) = 31 Then MonthEnd = True
'FEBRUARY
Case Is = 2
If Is_Leap_Year(CStr(DatePart("yyyy", sDate))) = False Then
If DatePart("d", sDate) = 28 Then MonthEnd = True
End If
If Is_Leap_Year(CStr(DatePart("yyyy", sDate))) = True Then
    If DatePart("d", sDate) = 29 Then MonthEnd = True
End If
'APRIL, JUNE, SEPTEMBER, NOVEMBER
Case 4, 6, 9, 11
If DatePart("d", sDate) = 30 Then MonthEnd = True
End Select

End_Of_Month = MonthEnd

End Function

Private Function End_Of_Year(sDate As String) As Boolean

Dim YearEnd As Boolean
YearEnd = False

Select Case DatePart("m", sDate)
'DECEMBER
Case Is = 12
'31st
If DatePart("d", sDate) = 31 Then YearEnd = True
Case Else
End Select

End_Of_Year = YearEnd

End Function

Private Function Start_Of_Month(sDate As String) As Boolean

Dim MonthStart As Boolean
MonthStart = False

Select Case DatePart("d", sDate)
Case Is = 1
MonthStart = True
Case Else
End Select

Start_Of_Month = MonthStart

End Function

Private Function Start_Of_Year(sDate As String) As Boolean

Dim YearStart As Boolean
YearStart = False

Select Case DatePart("m", sDate)
'JANUARY
Case Is = 1
'1st
If DatePart("d", sDate) = 1 Then YearStart = True
Case Else
End Select

Start_Of_Year = YearStart

End Function

Private Function Same_Month(startDate, endDate As String) As Boolean

Dim MonthSame As Boolean
MonthSame = False

If DatePart("m", startDate) = DatePart("m", endDate) Then
MonthSame = True
End If

Same_Month = MonthSame

End Function

Private Function Same_Year(startDate, endDate As String) As Boolean

Dim YearSame As Boolean
YearSame = False

If DatePart("yyyy", startDate) = DatePart("yyyy", endDate) Then
YearSame = True
End If

Same_Year = YearSame

End Function

Page tags: client vaguedates vba

page_revision: 37, last_edited: 1249052116|%e %b %Y, %H:%M %Z (%O ago)

Edit Tags History Files Print Site tools + Options

gcfrench

Get Start Date

NBN_Get End Date

Get Date Type

Other remarkable sites from Wikidot

Безброй математици

The Open Mob for Android(TM)

BestWackyIdeas

Dark Reign Chronicles