Create validation data list that can add a user's unique data

[Karlbirger]

Hi guys,

I'm stuck how to create a validation data list that is compatible for a user to either select a choice from a roll down list (range) or add his/her own value/data in the cell. The best solution would be that if the user want to add own unique data, the user would be asked to add it through a message box.

Very grateful for help in this matter.

FYI: Windows Vista and Excel 2007.

Regards,
Johan

 

[MickG]

This example assumes you have a Validation list in column "A" and a Validation cell in "B1".
This code is a double click Event. When "B1" is double Clicked an Input box appears where you can enter New Data for your list.
The Input data is added to you list in column "A" and the new data shows in the validation list.
To enter the code. Right click the sheet Tab, select "View Code" Vb window appears, Paste code into Vb window.
Close VB Window.
Double click "B1" to add data.

Private [COLOR=navy]Sub[/COLOR] Worksheet_BeforeDoubleClick(ByVal Target [COLOR=navy]As[/COLOR] Range, Cancel [COLOR=navy]As[/COLOR] Boolean)
[COLOR=navy]Dim[/COLOR] Last [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Txt [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]If[/COLOR] Target.Address(0, 0) = "B1" [COLOR=navy]Then[/COLOR]
    Last = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
     Txt = Application.InputBox(prompt:="Please enter New Data", Title:="Validation.add", Type:=2)
       [COLOR=navy]If[/COLOR] Txt = "" Or Txt = "False" [COLOR=navy]Then[/COLOR] [COLOR=navy]Exit[/COLOR] [COLOR=navy]Sub[/COLOR]
         Range("A" & Last) = Txt
          [COLOR=navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
            Range("B1").Select
[COLOR=navy]With[/COLOR] Selection.Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:="=" & Rng.Address & ""
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]If[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[Karlbirger]

Thx Mick!

Helped me alot.

Regards, Johan