Auto Update Validation List

i have a list called "parts". i want this list to be updated everytime a new part # is entered into the list cell. i can get it to work in one cell. i have been able to get it to work in up to 6 rows, however i want it to work in up to 50 rows. here is the vba code i am using

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lReply As Long

If Target.Cells.Count > 1 Then Exit Sub
If Target.Address >= "$D$3" Then
If IsEmpty(Target) Then Exit Sub
If WorksheetFunction.CountIf(Range("parts"), Target) = 0 Then
lReply = MsgBox("Add " & Target & " to list", vbYesNo + vbQuestion)
If lReply = vbYes Then
Range("parts").Cells(Range("parts").Rows.Count + 1, 1) = Target
End If
End If
End If
End Sub

i am using insert>name>define for the list and this is what i used for that

=OFFSET(lists!$A$1,0,0,COUNtA(lists!$A:$A),1)

like i said, it will work for d1-d6, then it stops working.