xlf EandA series


VBA function :: xlfDateToSerialNumber


This is a code development module, providing some code logic ideas, presented here as an exercise.


0. Preliminary


The EXERCISE - implement the following



Function procedure


Write a Public (UDF) Function procedure named xlfDateToSerialNumber with syntax:

xlfDateToSerialNumber(dte)

The xlfDateToSerialNumber function returns the Excel Serial Number days since 1 January 1900

The function has the following arguments:

  • dte Required. An ISO 8601 date of the form yyyymmdd as a number

Your code statements should be limited mostly to mathematical operators, logic statements, and code control procedures. Do not use any Excel or VBA Date and Time functions

 

1. The code


This version is based on coding techniques covered in 90045.

1.1 A version of the xlfDateToSerialNumber function



Code 1: the xlfDateToSerialNumber function. An interpretation of the set task 
Function xlfDateToSerialNumber(Dte As Long) As Long
' Description: Returns the serial number of a date (base 1 at 1 January 1900)
' Arguments: Dte required - entered as yyyymmdd, a number. ISO 8601 (basic format) _
'    19000101 to 99991231
' Return value range 1 to 2962576 _
'    includes the 29 February 1900 leap year error.
' Error value -1
' =================
Dim Y As Integer, M As Integer, D As Integer
Dim Days As Long, DaysInMth As Integer, MthDays As Integer, j As Integer
Dim Epoch As Long: Epoch = 19000101

' Dte integrity ===
If Len(CStr(Dte)) <> 8 Then GoTo ErrHandler ' CStr conversion resolves 4 digit error with 99991231
    Y = Left(Dte, 4): M = Mid(Dte, 5, 2): D = Right(Dte, 2)
If Not (Y >= 1900 And Y <= 9999) Or _
   Not (M >= 1 And M <= 12) Or _
   Not (D >= 1 And D <= 31) Then GoTo ErrHandler
' Years ===========
    For j = Left(Epoch, 4) To Y - 1
        If Not (j Mod 4 = 0 And (j Mod 100 <> 0 Or j Mod 400 = 0)) Then
            Days = Days + 365
        Else
            Days = Days + 366
        End If
    Next j
' Months ==========
    If M > 1 Then
    For j = Mid(Epoch, 5, 2) To M - 1
        Select Case j
        Case 1, 3, 5, 7, 8, 10, 12
            DaysInMth = 31
            MthDays = MthDays + DaysInMth
        Case 2
            If Not (Y Mod 4 = 0 And (Y Mod 100 <> 0 Or Y Mod 400 = 0)) Then
                DaysInMth = 28
                MthDays = MthDays + DaysInMth
            Else
                DaysInMth = 29
                MthDays = MthDays + DaysInMth
            End If
        Case 4, 6, 9, 11
            DaysInMth = 30
            MthDays = MthDays + DaysInMth
        End Select
    Next j
    End If
    Days = Days + MthDays
' Days ============
    Days = Days + D
    ' Include 1900 error
    If Dte > 19000228 Then Days = Days + 1
' Return value ====
    xlfDateToSerialNumber = Days
Exit Function

ErrHandler:
    xlfDateToSerialNumber = -1
End Function

1.2 Procedure testing

The testing platform is included in worksheet 1 of the workbook.


References