Access 2003 runtime error 6 overflow

I can't seem to work the bugs out of this database. This is the last one and it's wearing me out. I only get it on some entries. Does ayone have any suggestions?  Thanks all for looking!

When I debug, this is the area that gets highlighted.
 If Format(Me.ListCards.Column(2), "Short Date") < Date Then If Format(Me.ListCards.Column(2), "Short Date") < Date Then

Option Compare Database
 
Private Sub CardFilter_Enter()
    Me.CardFilter.BackStyle = "1"
End Sub
 
Private Sub CardFilter_Exit(Cancel As Integer)
    If IsNull(Me.CardFilter) Or Me.CardFilter = "" Then
        Me.CardFilter.BackStyle = "0"
        Me.ListCards.RowSource = "SELECT Cards.CardNo, CardStatus.Status, Cards.* FROM CardStatus " & _
         "INNER JOIN Cards ON CardStatus.StatusID=Cards.StatusID WHERE (((Cards.StatusID)<>5)) " & _
         "ORDER BY Cards.CardNo;"
    Else
        Me.CardFilter.BackStyle = "1"
    End If
End Sub
 
Private Sub CardFilter_KeyPress(KeyAscii As Integer)
    Dim str As String
    If IsNull(Me.CardFilter) Then
        str = Me.CardFilter.Text
    Else
        str = str & Me.CardFilter.Text
    End If
    Me.ListCards.RowSource = "SELECT Cards.CardNo, CardStatus.Status, * FROM CardStatus " & _
     "INNER JOIN Cards ON CardStatus.StatusID=Cards.StatusID WHERE (((Cards.StatusID)<>5)) " & _
     "AND ((Cards.RemDate) Is Null) AND Cards.CardNo Like '*" & str & "*' ORDER BY Cards.CardNo;"
End Sub
 
Private Sub CmdAddNew_Click()
    Me.AddNew = -1
    Me.ListCards = 0
    Me.CardNo.Enabled = True
    Me.CardNo = ""
    Me.Expiration.Enabled = True
    Me.Expiration = ""
    Me.CmdCalendar.Enabled = True
    Me.StatusID.Enabled = True
    Me.StatusID = 1
    Me.StatusDate.Locked = True
    Me.StatusDate = Date
    Me.ListCards.Enabled = False
    Me.ListCards.ForeColor = 12632256
    Me.CardFilter.Enabled = False
    Me.CardNo.SetFocus
    Me.CmdAddNew.Enabled = False
    Me.CmdSave.Enabled = True
End Sub
 
Private Sub CmdCalendar_Click()
    DoCmd.OpenForm "FrmCalendar"
    Forms!FrmCalendar!Cldr = 1
End Sub
 
Private Sub CmdCancel_Click()
    If MsgBox("Are you sure you want to cancel this card and remove it from inventory?" & vbCrLf & vbCrLf & _
    "Note:  If removed, the card's history will be retained in the system, but the system will not allow any future transactions with this card.", vbYesNo, "Confirm Removal") = vbNo Then
        Me.StatusID = 1
        Exit Sub
    End If
    
    Dim rstRemove As DAO.Recordset
    Set rstRemove = CurrentDb.OpenRecordset("Select * from Cards Where [CardID] = " & Me.ListCards.Column(2), dbOpenDynaset, dbSeeChanges)
    With rstRemove
        .Edit
        !StatusID = 5
        !StatusDate = Date
        !RemDate = Date
        !Editby = Me.TxtUserName
        !EditDateTime = Now
        .Update
    End With
    
    DoCmd.Close , , acSaveYes
    
    If MsgBox("Fleet card changes have been saved.  Would you like to make additional fleet card changes?", vbYesNo, "Edit More Cards?") = vbYes Then
        DoCmd.OpenForm "FrmCards"
    End If
    
End Sub
 
Private Sub CmdSave_Click()
    If IsNull(Me.CardNo) Then
        MsgBox "Please enter the 16 digit card number.", , "Enter Card Number!"
        Exit Sub
    End If
    If IsNull(Me.Expiration) Then
        MsgBox "Please enter the card's expiration date.", , "No Expiration Date!"
        Exit Sub
    End If
    If IsNull(Me.StatusID) Or Me.StatusID = 0 Then
        MsgBox "Please select the card's status from the list.", , "No Status Selected!"
        Exit Sub
    End If
    
    Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("Cards", dbOpenDynaset, dbSeeChanges)
    
    If Me.AddNew = -1 Then
        With rst
            .AddNew
            !CardNo = Me.CardNo
            !Expiration = Me.Expiration
            !StatusID = Me.StatusID
            !StatusDate = Date
            !RecDate = Date
            !Editby = Me.TxtUserName
            !EditDateTime = Now
            .Update
        End With
    Else
        rst.Filter = "CardID = " & Me.ListCards.Value
        Set rst = rst.OpenRecordset
        
        With rst
            .Edit
            !CardNo = Me.CardNo
            !Expiration = Me.Expiration
            !StatusID = Me.StatusID
            If Me.StatusID <> i Then
                !StatusDate = Me.StatusDate
            End If
            If Me.StatusID = 5 Then
                !RemDate = Date
            End If
            !Editby = Me.TxtUserName
            !EditDateTime = Now
            .Update
        End With
    End If
    
    DoCmd.Close , , acSaveYes
    
    If MsgBox("Fleet card changes have been saved.  Would you like to make additional fleet card changes?", vbYesNo, "Edit More Cards?") = vbYes Then
        DoCmd.OpenForm "FrmCards"
    End If
 
End Sub
 
Private Sub Form_Load()
    Me.TxtUserName = Forms!FEMAMaster!TxtUserName
    Me.ListCards = ""
    Me.ListCards.RowSource = "SELECT Cards.CardNo, CardStatus.Status, Cards.* " & _
     "FROM CardStatus INNER JOIN Cards ON CardStatus.StatusID = Cards.StatusID WHERE " & _
     "(((Cards.StatusID)<>5) AND ((Cards.RemDate) Is Null)) ORDER BY Cards.CardNo;"
End Sub
 
Private Sub ListCards_AfterUpdate()
    Me.CmdCancel.Enabled = True
    Me.CardNo.Enabled = True
    Me.Expiration.Enabled = True
    Me.CmdCalendar.Enabled = True
    Me.StatusID.Enabled = True
    Me.StatusDate.Locked = True
    Me.CmdSave.Enabled = True
    
    Me.AddNew = 0
    Dim i As Integer
    i = Me.ListCards.Column(5)
    Me.CardNo.Enabled = True
    Me.CardNo = Me.ListCards
    Me.Expiration.Enabled = True
    Me.Expiration = Format(Me.ListCards.Column(4), "Short Date")
    Me.CmdCalendar.Enabled = True
    Me.StatusID.Enabled = True
    Me.StatusID = Me.ListCards.Column(5)
    Me.StatusDate.Locked = True
    Me.StatusDate = Format(Me.ListCards.Column(6), "Short Date")
 
    If Format(Me.ListCards.Column(2), "Short Date") < Date Then
        Me.Expiration.ForeColor = vbRed
        Me.Expiration.FontBold = True
        MsgBox "The Selected Card Has Expired!", , "CARD EXPIRED"
    Else
        Me.Expiration.ForeColor = vbBlack
        Me.Expiration.FontBold = False
    End If
End Sub
 
Private Sub StatusID_AfterUpdate()
    If Me.StatusID = 3 Then
        MsgBox "Lost, Missing or Stolen Cards Should be Reported by Calling 1-888-297-0782", , "REPORT MISSING CARD!"
    End If
    Me.StatusDate = Date
End Sub

Select allOpen in new window