Code Listing 3: The Sliding Window Procedure for VBA

Public Function SafeCenturyVBA( _
  varDateIn As Variant, _
  intPivot As Integer) _
  As Variant
  ' Comments  : Returns the passed date with the century modified
  '             as determined by the specified pivot year. If the
  '             last two digits of the supplied date are less than
  '             or equal to the intPivot value, the 21st century is
  '             used. Otherwise, the 20th century is used.
  '             Note that any century information supplied in the
  '             varDateIn parameter is thrown away. This is because
  '             by the time a date gets to this procedure, VB has most
  '             likely already assumed the century and the date is
  '             therefore suspect.
  ' Parameters: varDateIn - variant containing a date. This can be
  '             a string or date, but must be one of the following
  '             formats:
  '               mm/dd/yy
  '               dd/mm/yy
  '               mm/dd/yyyy
  '               dd/mm/yyyy
  '             intPivot - year to pivot to the current century.
  ' Returns   : variant of type 7 (date) containing the transformed
  '             date or Null if the passed value cannot be evaluated
  '             as a date or an error occurs.
  '
  Dim intYear As Integer
  Dim fIsDate As Boolean
  Dim fOk As Boolean

  On Error GoTo PROC_ERR

  ' Assume failure
  fOk = False

  ' Determine if the passed value can
  Select Case VarType(varDateIn)
    
    Case vbDate
      ' Its a date, simply work on the century
      fOk = True

    Case vbString
      ' Its a string so we use IsDate to determine if the value is
      ' valid as a date. Note that IsDate() uses the date settings
      ' in the Windows Control Panel to determine validity. Therefore
      ' certain date formats (such as "Monday, June 3rd, 1995") will
      ' not be considered a valid date by this procedure. See the
      ' procedure comments for valid date formats for use with this
      ' procedure.
      On Error Resume Next
      fIsDate = IsDate(varDateIn)
      fOk = (Err = 0)
      On Error GoTo PROC_ERR

    Case vbLong
      ' Check to see if it is in the serial date range
      fOk = (varDateIn > -657434 And varDateIn < 2958465)

    Case Else
      ' Can't figure out what it is
      
  End Select

  If fOk Then
    ' Get the right-most two digits of the year. Note the use of
    ' Format function to ensure that the string we search in
    ' always has four digits.
    intYear = CInt(Right$(Format(varDateIn, "yyyy"), 2))
    
    ' Pivot the century. Note the use of explicit, hard-coded
    ' centuries. While this may appear to be non-Year 2000
    ' compliant (don't hardcode century data), it does
    ' specify the full four digits of the year. And since
    ' we need to rely on this procedure to make exactly
    ' the assumption we want, the hard-coded values are correct.
    If intYear > intPivot Then
      ' If the supplied two-digit year is greater than then
      ' pivot number, the returned value is in the 20th
      ' century.
      intYear = 1900 + intYear
    Else
      ' If the supplied two-digit year is less than or equal
      ' to the pivot number, the returned value is in the
      ' 21st century.
      intYear = 2000 + intYear
    End If
              
    ' Return the variant. Note that we we cast it explicitly as a date.
    SafeCenturyVBA = CVDate(Month(varDateIn) & _
                     "/" & Day(varDateIn) & _
                     "/" & intYear)
  Else
    SafeCenturyVBA = Null
  End If
  
PROC_EXIT:
  Exit Function
  
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "SafeCenturyVBA"
      
  SafeCenturyVBA = Null
      
  Resume PROC_EXIT
  
End Function

Back to main page