How to fix Run-time Error 13: Type Mismatch in my Code

[stseia]

Hi Guys, as the title said, I am having difficulty on fixing run-time error on this code that I have found. Basically this aims to delete all dates more than 1 months of today's month. Example Today is February, everything on and after April 1 will be deleted. Thanks a lot in advance!

Sub DeleteRowsLaterThanTwoMonths()

Dim lCol As Long
Dim lLastRow As Long
Dim lRow As Long
Dim dToday As Date
Dim dCellDate As Date
Dim dTwoMonthsLater As Date

'Determine the column number of the "Next Progression Date" column
lCol = FindColumn("Next Progression Date")

'Get today's date
dToday = Date

'Determine two months later
dTwoMonthsLater = DateSerial(Year(dToday), Month(dToday) + 2, 1)

'Determine the last row in the "Next Progression Date" column
lLastRow = ActiveSheet.Cells(Rows.Count, lCol).End(xlUp).Row

'Start at the bottom of the "Next Progression Date" column and work up
For lRow = lLastRow To 1 Step -1

    'Get the date value in the current cell
    dCellDate = Cells(lRow, lCol).Value

    'Check if the date value is later than two months from today
    If dCellDate >= dTwoMonthsLater Then

        'Delete the entire row that contains the cell
        Rows(lRow).Delete

    End If

Next lRow

End Sub

'Function to find the column number of a header
Function FindColumn(sHeader As String) As Long

    FindColumn = Cells.Find(What:=sHeader, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
                            SearchDirection:=xlNext, MatchCase:=False).Column

End Function

 

[HaHoBe]

Hi stseia,

are you sure that your row 1 in the column to search holds a Date and not the string "Next Progression Date"?

For lRow = lLastRow To 2 Step -1

Holger

 

[Z51]

Change the For lRow statement to:

For lRow = lLastRow To 2 Step -1

Assuming your headers are in row 1, it can't store the string in that row as a Date variable.

 

[stseia]

Wow that was fast! Thank you both @HaHoBe and @Z51 This was a huge help.

 

[HaHoBe]

Hi stseia,

thanks for the feedback.

If you run the code on a sheet where the header is not found the function will raise runtime error 91. And if the header is not in the first row you would need to adjust that by hand. Have a look at the modified version which will either deliver the address of the searched header from which we can get the column and row to insert into the code or an empty string to exit the sub:

Sub DeleteRowsLaterThanTwoMonths_mod()

Dim strAddress As String
Dim lLastRow As Long
Dim lRow As Long
Dim dToday As Date
Dim dCellDate As Date
Dim dTwoMonthsLater As Date

'Determine the column number of the "Next Progression Date" column
strAddress = FindAddress("Next Progression Date")

If strAddress = "" Then Exit Sub

'Get today's date
dToday = Date
'Determine two months later
dTwoMonthsLater = DateSerial(Year(dToday), Month(dToday) + 2, 1)

'Determine the last row in the "Next Progression Date" column
lLastRow = ActiveSheet.Cells(Rows.Count, Range(strAddress).Column).End(xlUp).Row

'Start at the bottom of the "Next Progression Date" column and work up
For lRow = lLastRow To Range(strAddress).Offset(1, 0).Row Step -1
    'Get the date value in the current cell
    dCellDate = Cells(lRow, Range(strAddress).Column).Value
    'Check if the date value is later than two months from today
    If dCellDate >= dTwoMonthsLater Then
        'Delete the entire row that contains the cell
        Rows(lRow).Delete
    End If
Next lRow

End Sub

'Function to find the address of a header
Function FindAddress(sHeader As String) As String

  If WorksheetFunction.CountIf(ActiveSheet.UsedRange, sHeader) > 0 Then
    FindAddress = Cells.Find(What:=sHeader, _
                              LookAt:=xlWhole, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlNext, _
                              MatchCase:=False).Address
  End If

End Function

Ciao,
Holger