505.369.1650 [email protected]

This VBA procedure converts a number, in yyyymmdd format, to a regular date like mm/dd/yyyy.  For example, a number like 20090427 will get converted to 4/27/2009.  It is a good example of how to use the DateSerial function.

Code:

Public Function DateFromNumber(DateNumber)
' This function returns a date from the DateNumber value.
' For example, 20090109 returns 1/9/2009.  It returns a Null
' if DateNumber cannot be parsed.

' DateFromNumber() Version 1.0.0
' Copyright © 2009 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected].
' Use (at your own risk) and modify freely as long as proper credit is given.
On Error GoTo Err_DateFromNumber

    Dim strYear As String
    Dim strMonth As String
    Dim strDay As String
   
    ' If the argument is Null, then pass back Null.
    If IsNull(DateNumber) Then
        DateFromNumber = Null
        GoTo Exit_DateFromNumber
    End If
   
    ' If the argument has the wrong number of characters,
    ' then pass back Null.
    If Len(CStr(DateNumber))  8 Then
        DateFromNumber = Null
        GoTo Exit_DateFromNumber
    End If
   
    ' If the argument is not numeric, then pass back Null.
    If Not IsNumeric(DateNumber) Then
        DateFromNumber = Null
        GoTo Exit_DateFromNumber
    End If
   
    ' Get the year, month, and day from the number.
    ' Exit with a Null if the month or day is outside the
    ' normal range.
    strYear = Mid(DateNumber, 1, 4)
    strMonth = Mid(DateNumber, 5, 2)
    If CInt(strMonth) > 12 Then
        DateFromNumber = Null
        GoTo Exit_DateFromNumber
    End If
    strDay = Mid(DateNumber, 7, 2)
    If CInt(strDay) > 31 Then
        DateFromNumber = Null
        GoTo Exit_DateFromNumber
    End If
   
    ' Build the date and pass it back.
    DateFromNumber = DateSerial(strYear, strMonth, strDay)
   
Exit_DateFromNumber:
    On Error Resume Next
    Exit Function
   
Err_DateFromNumber:
    MsgBox Err.Number & " " & Err.DESCRIPTION, vbCritical, "DateFromNumber()"
    DateFromNumber = Null
    Resume Exit_DateFromNumber
   
End Function

Download Code:

basDateFromNumber