Try the following:-
Your Children's names in sheet1 column "A".
The validation list will be in sheet2 "A1" when you first run the code.
Place all the code below into the Worksheet module of sheet 2.
To place code:-
Right click sheet "Tab" , select ViewCode", Vbwindow appears , Paste entire code into this window
Close vbwindow.
To Fill Validation list code:-
Doubleclick in cell sheet2 "A1"
Validation list should appear with your Names in it in "A1".
Select name from validation list, The selection should show in column "D".
continue with selection until all names are in column "D".
To reset Validation list. Double click again in cell "A1 sheet2.
Code:
Option Explicit
[COLOR=Navy]Dim[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Rng1 [COLOR=Navy]As[/COLOR] Range
Private [COLOR=Navy]Sub[/COLOR] Worksheet_BeforeDoubleClick(ByVal Target [COLOR=Navy]As[/COLOR] Range, Cancel [COLOR=Navy]As[/COLOR] Boolean)
Application.EnableEvents = False
[COLOR=Navy]With[/COLOR] Sheets("Sheet1")
[COLOR=Navy]Set[/COLOR] Rng1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]If[/COLOR] Target.Address(0, 0) = "A1" [COLOR=Navy]Then[/COLOR]
Target = ""
[COLOR=Navy]With[/COLOR] Range("A1").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(Application.Transpose(Rng1.Value), ",")
[COLOR=Navy]End[/COLOR] With
Columns("D:D").ClearContents
[COLOR=Navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Private [COLOR=Navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=Navy]As[/COLOR] Range)
Application.EnableEvents = False
[COLOR=Navy]If[/COLOR] Target.Count = 1 [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]If[/COLOR] Target.Address(0, 0) = "A1" And Not Target = "" [COLOR=Navy]Then[/COLOR]
Call AddVal(Target)
[COLOR=Navy]With[/COLOR] Range("A1").Validation
.Delete
[COLOR=Navy]If[/COLOR] Dic.Count > 0 [COLOR=Navy]Then[/COLOR] .Add Type:=xlValidateList, Formula1:=Join(Dic.keys, ",")
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
[COLOR=Navy]
Sub[/COLOR] AddVal(Tar [COLOR=Navy]As[/COLOR] Range)
[COLOR=Navy]Dim[/COLOR] Dn [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Rng2 [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Sht [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Nums [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]If[/COLOR] Tar.Address(0, 0) = "A1" [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]With[/COLOR] Sheets("Sheet1")
[COLOR=Navy]Set[/COLOR] Rng1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]With[/COLOR] Sheets("Sheet2")
[COLOR=Navy]Set[/COLOR] Rng2 = .Range(.Range("D1"), .Range("D" & Rows.Count).End(xlUp))
Nums = IIf(Rng2.Count = 1 And Rng2(1) = "", 1, Rng2.Count + 1)
[COLOR=Navy]If[/COLOR] Nums = 2 [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]If[/COLOR] Tar = .Range("D" & Nums - 1) [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Exit[/COLOR] [COLOR=Navy]Sub[/COLOR]
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]If[/COLOR] Nums <= Rng1.Count [COLOR=Navy]Then[/COLOR] .Range("D" & Nums) = Tar
[COLOR=Navy]Set[/COLOR] Rng2 = .Range(.Range("D1"), .Range("D" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Sht = Array(Rng1, Rng2)
[COLOR=Navy]For[/COLOR] n = 0 To 1
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Sht(n)
[COLOR=Navy]If[/COLOR] Not Dn.Value = vbNullString [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
Dic.Add Dn.Value, Nothing
[COLOR=Navy]Else[/COLOR]
Dic.Remove (Dn.Value)
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick