If you are using data validation (and you should) to help you with your data entry, then you might find that the list you are using doesn't have all the values you want.
For example, if you were using a list to assign a priority to some work, your list may consist of 'Not Started', 'In Progress' and 'Completed'. But later on you realise that you need to add 'On Hold' and 'Cancelled'.
In my case I'm putting a roster together of who's making me a cup of tea, and I'm using a list of staff names: Amanda, Gary, Hannah and Xavier. A few weeks later I hire Bruce and Kylie and I want to add their names to the list.
Normally you'd just go to the source table and add these names, and you can still do that, but with this code it's even easier. You just type in Bruce, and then Kylie, and their names are automatically added to the source data validation list.
This may seem a strange thing to be doing.
The use of data validation is to limit the choices and therefore control what is entered.
So to allow someone to add to that list without checking what is entered goes against the whole point of data validation lists.
But, we have had requests to do this so here is a working example.
Just bear in mind that if you release this to users they can add whatever they want to your DV lists.
But if it is for use just by yourself (or trusted others) then you may find this very useful.
Both Bruce and Kylie then become available to use in the drop down list.
And for even more coolness, after I've added the new names, I sort the list alphabetically.
Let's back up a bit though and look at how we put this all together.
Set up your source table, and populate it with your staff names (or whatever you are using). Then set up the output table similarly.
Set Up Data Validation List Source
Next we need to configure our source list which will be used for the data validation.
There are a few quirks when using tables as the source for data validation lists so please read that article if you are not familiar with them.
The name of my source table is Persons, and to get around the aforementioned quirks, I've opted to create a 2nd name for my source table, Person_Table, and use this when setting up the data validation.
My roster of tea makers is a table called RosterTable.
That's all I need to do in the sheet, the rest is in the VBA.
Writing the VBA
Firstly, I'm using a Worksheet_Change worksheet event that triggers every time the sheet changes.
When this code executes, I check if the active cell (the one that just changed) is in my RosterTable. I do this by checking if the Target (the active cell) is in the ListObject (table) named RosterTable
If Target.ListObject.Name <> "RosterTable"
I also have to check a couple of other things, both of which would mean exiting the VBA code and doing nothing. The first thing to check is if the value in the changed cell is empty
Target.Value = ""
The second thing is if the changed cell is the header row of the table RosterTable
(Not Intersect(Target, Target.ListObject.HeaderRowRange) Is Nothing)
If either of these conditions are true, the code exits. Putting it all together it looks like this
On Error Resume Next ' IF the cell that has just changed (Target) isn't in our Output Table OR ' if that same cell is blank OR ' that same cell is the header of our Output table THEN ' turn default error handling back on and exit the sub If Target.ListObject.Name <> "RosterTable" Or Target.Value = "" Or (Not Intersect(Target, Target.ListObject.HeaderRowRange) Is Nothing) Then 'Turn default error handling back on On Error GoTo 0 Exit Sub End If 'Turn default error handling back on On Error GoTo 0
You'll notice that I have turned off default error handling
On Error Resume Next
Because checking the value of Target.ListObject.Name can result in an error if the Target cell isn't in a table (ListObject), I need to allow for this and prevent Excel generating an error.
Once I've done this check I can turn default error handling back on
On Error GoTo 0
Checking for a New Name, and Adding it to the List
Once we confirm that the changed cell is in the RosterTable we check if a new name has been typed in. This is really easy to do using the Find method
If .Range("Persons").Find(Target.Value) Is Nothing Then
So, if the Find method looks for the value of the target (changed) cell in the range "Persons" (the Persontable), and finds nothing, we have a newly typed in name.
Let's add it to our PersonTable
With .ListObjects("Persons") .ListRows.Add .ListRows(NameTable.ListRows.Count).Range.Cells(1, 1) = Target.Value
and sort the list of names
With NameTable.Sort .SortFields.Add NameTable.DataBodyRange.Cells(1, 1), xlSortOnValues, xlAscending .Apply .SortFields.Clear End With
and that's it.
The CodeBelow is all the code put together which you can copy/paste. Or you can download a .xlsm workbook.
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) ' Written by Philip Treacy ' https://www.myonlinetraininghub.com/automatically-add-items-to-data-validation-list Dim NameTable As ListObject ' Need to switch off default error handling ' as .ListObject.Name can generate an error On Error Resume Next ' IF the cell that has just changed (Target) isn't in our RosterTable OR ' if that same cell is blank OR ' that same cell is the header of our RosterTable THEN ' turn default error handling back on and exit the sub If Target.ListObject.Name <> "RosterTable" Or Target.Value = "" Or (Not Intersect(Target, Target.ListObject.HeaderRowRange) Is Nothing) Then 'Turn default error handling back on On Error GoTo 0 Exit Sub End If 'Turn default error handling back on On Error GoTo 0 Application.ScreenUpdating = False Application.EnableEvents = False Set NameTable = Worksheets("Add Items to DVL").ListObjects("Persons") With Worksheets("Add Items to DVL") ' If the new name isn't in the Persons table then add it to the Persons table If .Range("Persons").Find(Target.Value) Is Nothing Then 'User typed something in With .ListObjects("Persons") .ListRows.Add .ListRows(NameTable.ListRows.Count).Range.Cells(1, 1) = Target.Value ' Sort the Persons table alphabetially A -> Z With NameTable.Sort .SortFields.Add NameTable.DataBodyRange.Cells(1, 1), xlSortOnValues, xlAscending .Apply .SortFields.Clear End With End With End If End With Application.ScreenUpdating = True Application.EnableEvents = True End Sub
If you liked this or know someone who could use it please click the buttons below to share it with your friends and colleagues.