Reputation: 1048
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.
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
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