Type Mismatch Run Time Error with Code when deleting multiple cells contents

[DCCC93]

Hi all,

I've been using the below code to automatically enter today's date in column b when entering anything into column a - which has been working perfectly.

Private Sub Worksheet_Change(ByVal Target As Range)
' If you update a cell in column A with a value and there is no date in the corresponding row of column B then
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Value <> "" And Range("B" & Target.Row).Value = "" Then
' Insert today's date in the corresponding row of column B
Range("B" & Target.Row).Value = Date
' Else if you remove the value from a cell in column A then
ElseIf Not Intersect(Target, Range("A:A")) Is Nothing And Target.Value = "" And Range("B" & Target.Row).Value <> "" Then
' Clear the value from the corresponding row of column B
Range("B" & Target.Row).ClearContents
End If
End Sub


However, I've just noticed that when I delete the contents of multiple cells at one time anywhere in the worksheet I get a Run Time Error 13 - Type Mismatch.

It highlights the second line If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Value <> "" And Range("B" & Target.Row).Value = "" Then in the debugger so is it something to do with the Target part?

I can't work out how to correct it and wondered if anyone might know?

Thanks
DC

 

[Jonmo1]

Try adding this as the first line

If Target.Count > 1 Then Exit Sub

 

[Andrew Poulsom]

At the beginning of your procedure put:

If Target.Rows.Count > 1 Then Exit Sub

 

[DCCC93]

Thank you both very much, that has worked great. Much appreciated!

DC

 

[Jonmo1]

You're welcome.