daniel blythe
daniel blythe

Reputation: 1048

Error 13, type mismatch after row deleted in Worksheet_Change

I have an Excel spreadsheet with two sheets. In sheet1 I have multiple rows each with a dropdown which is used to set the status of the row. If the status gets changed to 'Completed' or 'On Hold' it should get deleted from sheet1 and moved to the next available row in sheet2.

However after it is deleted from sheet1 I get

Run-time error 13 - type mismatch

Below is a screenshot of the highlighted code, link to screen capture of the error, screenshot of sheet1 and the highlighted debug code.

Sheet1

Highlighted debugged code

https://youtu.be/7xbinC6meHw

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    Set KeyCells = Range("B:B")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

            If (Target.Value = "Complete" Or Target.Value = "On Hold") Then
                ActiveCell.EntireRow.Copy
                Worksheets("Sheet2").Activate
                i = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
                Worksheets("Sheet2").Cells(i + 1, 1).Select
                ActiveSheet.Paste
                Worksheets("Sheet1").Activate
                ActiveCell.EntireRow.Delete
            End If

    End If
End Sub

Upvotes: 0

Views: 1063

Answers (1)

FunThomas
FunThomas

Reputation: 29612

This is a common problem for Worksheet_Change-routines that modify the sheet itself - this will trigger a new Change-Event (In that second event, target is the complete row that is currently deleted and checking the value of a Range with more than one cell will raise this error 13).

It is easy to prevent such problems: you have to disable events while the event-routine is running.

Update: Modified the code to show how to use Copy without Select

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Application.EnableEvents = False  ' Disable events while routine is doing its duty
    On Error Goto ChangeExit          ' Ensure that events are switched on in any case

    Set KeyCells = Range("B:B")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

        With Target.Cells(1, 1)
            If (.Value = "Complete" Or .Value = "On Hold") Then
                Dim lastRow As Long
                lastRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).row

                .EntireRow.Copy Worksheets("Sheet2").Cells(lastRow + 1, 1)
                .EntireRow.Delete
            End If
        End With
    End If
ChangeExit:
    Application.EnableEvents = True
End Sub

Upvotes: 6

Related Questions