CODEWITHSUNDEEP
excelvba
ahinkle
ahinkle

Reputation: 2261

Delete rows mismatch error

I'm trying to delete some rows in an Excel sheet based on a cell value that is a date. Sheet 1, D6 is a date.

Sub SAVE()
'----- DELETE OLD ROWS -----
Dim r As Range
Dim x As Integer
Dim Monday As String
Dim Tuesday As String
Dim Wednesday As String
Dim Thursday As String
Dim Friday As String
Dim Saturday As String
Dim Sunday As String
Monday = Sheet1.Range("D6").Value
Tuesday = Sheet1.Range("D6").Value + 1
Wednesday = Sheet1.Range("D6").Value + 2
Thursday = Sheet1.Range("D6").Value + 3
Friday = Sheet1.Range("D6").Value + 4
Saturday = Sheet1.Range("D6").Value + 5
Sunday = Sheet1.Range("D6").Value + 6

For x = 5000 To 2 Step -1 '---> Change as needed

  Set r = Range("A" & Format(x))
  If UCase(r.Value) = Monday Then
    Rows(x).EntireRow.Delete
  End If

  Set r = Range("A" & Format(x))
  If UCase(r.Value) = Tuesday Then
    Rows(x).EntireRow.Delete
  End If

  Set r = Range("A" & Format(x))
  If UCase(r.Value) = Wednesday Then
    Rows(x).EntireRow.Delete
  End If

  Set r = Range("A" & Format(x))
  If UCase(r.Value) = Thursday Then
    Rows(x).EntireRow.Delete
  End If

  Set r = Range("A" & Format(x))
  If UCase(r.Value) = Friday Then
    Rows(x).EntireRow.Delete
  End If

  Set r = Range("A" & Format(x))
  If UCase(r.Value) = Saturday Then
    Rows(x).EntireRow.Delete
  End If

  Set r = Range("A" & Format(x))
  If UCase(r.Value) = Sunday Then
    Rows(x).EntireRow.Delete
  End If

Next
End Sub

This code works sometimes. Every so often I get a Run-time error '13' Type Mismatch. When I click debug, it highlights If UCase(r.Value) = Monday Then.

The error is: r.Value = Error 2023, Monday = "7/4/2016"

Image of the sheet it is pulling from:

enter image description here

Any ideas what's going on here?

Upvotes: 2

Views: 635

Answers (2)

omegastripes
omegastripes

Reputation: 12612

I suppose the code below will do what you intend:

Sub SAVE()
    ' Sheet1 is named "Control Panel", Sheet1 D6 has the pull date
    ' Sheet5 is named "Database", has the stored dates to delete
    '----- DELETE OLD ROWS -----
    Dim dtFrom As Date
    Dim dtUpto As Date
    Dim y As Long
    Dim vCont As Variant
    dtFrom = Sheets("Control Panel").Range("D6").Value
    dtUpto = dtFrom + 6
    With Sheets("Database")
        For y = 5000 To 2 Step -1
            vCont = .Cells(y, 1).Value
            If Not IsError(vCont) Then
                If vCont >= dtFrom And vCont <= dtUpto Then
                    .Rows(y).EntireRow.Delete
                End If
            End If
        Next
    End With
End Sub

Upvotes: 2

Vegard
Vegard

Reputation: 4952

Backup your workbook and try this refactor (now modified as per omegastripes' suggestion):

Sub SAVE()
    '----- DELETE OLD ROWS -----
    Dim r As Range, x As Integer, y As Variant

    y = Sheet1.Range("D6").Value + 3

    For x = 5000 To 2 Step -1
        Set r = Range("A" & x)
        If DateDiff("d", y, r.Value) <= 3 Then Rows(x).EntireRow.Delete
    Next x
End Sub

Upvotes: 0

Related Questions