In the code below I have an Array setup (or so I think), How do I use it to
delete the rows that have been copied?
What I have fails with Error 9, subscript out of range.

'======
Sub test1()
sUserPart = InputBox(("Enter a Value!"), Default:="8769")
With Sheets("Sheet1")
Sh1LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Sh1LastRow = Sh1LastRow + 1
Set Sh1Range = .Range("B1:B" & Sh1LastRow)
End With
sFound = False
For Each sh1cell In Sh1Range
If sh1cell.Value Like "*" & sUserPart & "*" Then
sFound = True
Application.Goto
Reference:=Worksheets("Sheet1").Range(sh1cell.Addr ess), _
Scroll:=True
vSelection = MsgBox("Use this selection? " & sh1cell.Value & "
", vbYesNoCancel)
If vSelection = vbYes Then
sFound = True
With Sheets("Sheet2")
sh2lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh2Range = .Range("A1:A" & sh2lastrow)
If Sheets("Sheet2").Range("A" & sh2lastrow).Value < ""
Then
sh2lastrow = sh2lastrow + 1
End If
End With
sh1cell.EntireRow.Copy
Destination:=Sheets("Sheet2").Range("A" & sh2lastrow)
Dim N As Long
Dim CellArray() As Variant
N = N + 1
ReDim Preserve CellArray(1 To N)
CellArray(N) = sh1cell.Address
End If
ElseIf vSelection = vbNo Then
sFound = False
ElseIf vSelection = vbCancel Then
sFound = False
GoTo EndIt
End If
Next sh1cell
If sFound = False Then
MsgBox "No Match Found!"
End If
If N 0 Then
Sheets(CellArray()).EntireRow.Delete 'reports error 9
Selection.Delete
End If
EndIt:
Range("A1").Activate
End Sub
'======
--
Regards

VBA.Newb.Confused
XP Pro
Office 2007