Error 1004 using Worksheet_Change if multiple cells are changed using paste

[dlinker]

I'm using Excel 2007
I have a Spreadsheet with two sheets, one for data entry and one with a set of data for lookup
I have written a Worksheet_Change macro that when an ID is entered into column 3 of the data entry sheet, it looks up certain columns in the data and if they are blank puts a cross symbol in a corresponding column on the data entry sheet.
This was all working fine when I checked that the Target Range was only a single cell.
I then got more complex and decided to also allow multiple values to be pasted - typically by cutting and pasting a list of IDs from another application.
The code all looks fine - but when attempting to insert more than one value in the corresponding column, I get the error "error '1004' Application-defined or object-defined error". Inserting a single value still works.
Note - I also have a Worksheet_SelectionChange macro that will check and uncheck in certain columns when those cells are clicked on. I've included this for completeness.
Both of these are in the Worksheet module for the data entry sheet.


The worksheets (modified to protect the innocent :- )
Data entry - only column C (Site Number) is changed:

A	B	Site Number	Impacted Site Names	State	Postcode	Old Site Number	Tech1	Tech2	Tech3	Tech4
1	23	200002	Sydney	NSW	2000	2000		r	r	r
1	45	202036	Nowra	NSW	2028	2028		r
1	45	303026	Melbourne	VIC	3083	3083		r	r
1	43	303028	Bendigo	VIC	3002	3002			r	r
1	32	303123	Ballarat	VIC	3064	3064		r
1	12	303124	Geelong	VIC	3141	3141			r

<tbody>
</tbody>

"Site Address" sheet used for VLOOKUP:

SiteID	Alt SiteID	Site	Tech1	Tech2	Tech3	Tech4
200002	2	Sydney	A0002
200003	3	Newcastle	A0003
200004	4	Woollongong	A0004	F0004	Q2004
202036		Nowra	A2036		Q2036
303026		Melbourne	A3026			Z9026
303028		Bendigo	A3028	F3028
303123		Ballarat	A3123		Q3123	Z3123
303124		Geelong	A3124	F3424		Z3128

<tbody>
</tbody>

Private Sub Worksheet_Change(ByVal Target As Range)
'Check changes cell is in the Site Numbers range
Dim cCurrent As Range
If Intersect(Target, Range("SiteNumbers")) Is Nothing Then Exit Sub
'Limit Target count to 1
'If Target.Count > 1 Then Exit Sub
For Each cCurrent In Target
If cCurrent.Value = "" Then
For K = 1 To 4
Cells(cCurrent.Row, K + 7).Value = ""
Next K
Else
' Check that site is valid - and if not show error message
If Application.IsNA(Cells(cCurrent.Row, cCurrent.Column + 1).Value) Then
MsgBox cCurrent.Value & " is not a valid Site Number", vbOKOnly, "Invalid Site"
cCurrent.Value = ""
cCurrent.Select
Else
' Check if there is a blank row above the current row - if so move the site up a row
If Cells(cCurrent.Row - 1, cCurrent.Column).Value = "" Then
Cells(cCurrent.Row - 1, cCurrent.Column).Value = cCurrent.Value
cCurrent.Value = ""
Else
On Error Resume Next
For J = 1 To 4
If Application.VLookup(cCurrent.Value, Worksheets("Site Address").Range("SiteList"), J + 3, False) = "" Then
MsgBox "Vlookup returned blank, cCurrent.Row=" & cCurrent.Row & "; J=" & J
Application.EnableEvents = False
Cells(cCurrent.Row, J + 7).Value = "r" ' <----- This line is generating to 1004 error
MsgBox Err & ": " & Error(Err)
Application.EnableEvents = True
Else
MsgBox "Vlookup returned a value, cCurrent.Row=" & cCurrent.Row & "; J=" & J
Application.EnableEvents = False
Cells(cCurrent.Row, J + 7).Value = "" ' <----- This line is generating to 1004 error
MsgBox Err & ": " & Error(Err)
Application.EnableEvents = True
End If
MsgBox "After if"
Cells(cCurrent.Row, J + 7).Font.Name = "marlett"
Cells(cCurrent.Row, J + 7).Font.Size = "10"
Cells(cCurrent.Row, J + 7).Font.Bold = True
MsgBox "before next J in loop"
Next J
On Error GoTo 0
MsgBox "just after J loop"
End If
End If
End If
Next
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Only toggle checkmark if Target is in a specific range
If Intersect(Target, Range("Technologies")) Is Nothing Then Exit Sub
' Check that there is a Site Number in Column C
If Cells(Target.Row, 3).Value = "" Then Exit Sub
'Move selection to start of Row so we can toggle on and off
'prevent Select event triggering again when we extend the selection below
Application.EnableEvents = False
Cells(Target.Row, 1).Select
Application.EnableEvents = True
'set Target font to marlett 10 Bold
Target.Font.Name = "marlett"
Target.Font.Size = "10"
Target.Font.Bold = True
'Check value of target and if it's not a
If Target.Value = "" Then
Target.Value = "a" 'Sets target Value = "a" which is a tick
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.ClearContents 'Sets Target Value = ""
Cancel = True
Exit Sub
End If
End Sub


Many thanks in advance for any help with this.