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:
[TABLE="width: 801"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]Site Number[/TD]
[TD]Impacted Site Names[/TD]
[TD]State[/TD]
[TD]Postcode[/TD]
[TD]Old Site Number[/TD]
[TD]Tech1[/TD]
[TD]Tech2[/TD]
[TD]Tech3[/TD]
[TD]Tech4[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]23[/TD]
[TD]200002[/TD]
[TD]Sydney[/TD]
[TD]NSW[/TD]
[TD]2000[/TD]
[TD]2000[/TD]
[TD][/TD]
[TD]r[/TD]
[TD]r[/TD]
[TD]r[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]45[/TD]
[TD]202036[/TD]
[TD]Nowra[/TD]
[TD]NSW[/TD]
[TD]2028[/TD]
[TD]2028[/TD]
[TD][/TD]
[TD]r[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]45[/TD]
[TD]303026[/TD]
[TD]Melbourne[/TD]
[TD]VIC[/TD]
[TD]3083[/TD]
[TD]3083[/TD]
[TD][/TD]
[TD]r[/TD]
[TD]r[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]43[/TD]
[TD]303028[/TD]
[TD]Bendigo[/TD]
[TD]VIC[/TD]
[TD]3002[/TD]
[TD]3002[/TD]
[TD][/TD]
[TD][/TD]
[TD]r[/TD]
[TD]r[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]32[/TD]
[TD]303123[/TD]
[TD]Ballarat[/TD]
[TD]VIC[/TD]
[TD]3064[/TD]
[TD]3064[/TD]
[TD][/TD]
[TD]r[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]12[/TD]
[TD]303124[/TD]
[TD]Geelong[/TD]
[TD]VIC[/TD]
[TD]3141[/TD]
[TD]3141[/TD]
[TD][/TD]
[TD][/TD]
[TD]r[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

"Site Address" sheet used for VLOOKUP:
[TABLE="width: 571"]
<tbody>[TR]
[TD]SiteID[/TD]
[TD]Alt SiteID[/TD]
[TD]Site[/TD]
[TD]Tech1[/TD]
[TD]Tech2[/TD]
[TD]Tech3[/TD]
[TD]Tech4[/TD]
[/TR]
[TR]
[TD]200002[/TD]
[TD]2[/TD]
[TD]Sydney[/TD]
[TD]A0002[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]200003[/TD]
[TD]3[/TD]
[TD]Newcastle[/TD]
[TD]A0003[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]200004[/TD]
[TD]4[/TD]
[TD]Woollongong[/TD]
[TD]A0004[/TD]
[TD]F0004[/TD]
[TD]Q2004[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]202036[/TD]
[TD][/TD]
[TD]Nowra[/TD]
[TD]A2036[/TD]
[TD][/TD]
[TD]Q2036[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]303026[/TD]
[TD][/TD]
[TD]Melbourne[/TD]
[TD]A3026[/TD]
[TD][/TD]
[TD][/TD]
[TD]Z9026[/TD]
[/TR]
[TR]
[TD]303028[/TD]
[TD][/TD]
[TD]Bendigo[/TD]
[TD]A3028[/TD]
[TD]F3028[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]303123[/TD]
[TD][/TD]
[TD]Ballarat[/TD]
[TD]A3123[/TD]
[TD][/TD]
[TD]Q3123[/TD]
[TD]Z3123[/TD]
[/TR]
[TR]
[TD]303124[/TD]
[TD][/TD]
[TD]Geelong[/TD]
[TD]A3124[/TD]
[TD]F3424[/TD]
[TD][/TD]
[TD]Z3128[/TD]
[/TR]
</tbody>[/TABLE]

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.