In Excel, is there a way to create a dropdown menu or data validation field that

  • Allows the user to enter a value that is not currently on the list (like a combo box)
  • Save that value in the dropdown list, so that the next time the user pulls up that list in a new field that new value they entered appears in the dropdown
  • Remove duplicate entries from the dropdown (ie, if the user has entered the vale "Apple" several times in the column, it only appears once in the dropdown)
  • (optional) Sort the dropdown alphabetically

The first thing I tried was applying data validation to a column, setting it to list, and setting the list source to that same column. This manages to achieve the first two bullet points, but unfortunately doing it this way duplicates each value every time it is used in the column (and it doesn't sort the list nicely either).

Any help is appreciated!

  • 1
    I don't know a native solution offhand. Have you tried a VBA solution? – Engineer Toast Jul 8 '15 at 20:09
  • 1
    I'v never used VBA, but if anyone can show me a solution that uses it (or at least explain how I might go about building my own) I'm willing to learn (I can program in other languages, so the learning curve wouldn't be too steep) – realityChemist Jul 8 '15 at 20:30
  • 1
    If you've already got the first two bullets solved, then you only need VBA to keep the list clean. The Worksheet_Change event will fire when cells change. Use something like If Not Intersect(Target,Range("A:A")) Is Nothing to determine if the change is in the area you care about. You can use the macro recorder to get some (usually poorly written) code to remove duplicates and sort the list. Take a stab at it. Update here with the results. – Engineer Toast Jul 8 '15 at 21:13

The code bellow generates a combo list (data validation) and:

  • Allows users to enter a value not currently on the list
  • Adds all new values to the drop-down list
  • Removes duplicate entries
  • Trims all values in the list
  • Sorts the list alphabetically

Where to paste the code:

  • Open the VBA editor: Alt + F11

    1. the first sub Worksheet_Change() has to be inserted in the VBA module of the sheet
  • All other subs and functions (sections 1 and 2) should be pasted in a new VBA module

    1. in the editor click menu Insert > Module and paste the new code


In Sheet1 module (Microsoft Excel Objects, top-left of VBA editor):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Columns.Count = 1 Then setList Target
End Sub


1 of 2 (new VBA module):

Option Explicit

Public Sub setList(ByRef rng As Range, Optional fullColumn As Boolean = True)
   Dim ws As Worksheet, lst As Range, lr As Long

   If rng.Columns.Count = 1 Then
      xlEnabled False
      Set ws = rng.Parent
      Set lst = ws.UsedRange.Columns(rng.Column)
      lr = setLastRow(lst, rng.Column)
      If lr > 1 Then
         If fullColumn Then Set lst = ws.Columns(rng.Column)
         With lst.Validation
            .Add Type:=xlValidateList, Formula1:=getDistinct(lst, lr)
            .ShowError = False
         End With
      End If
      xlEnabled True
   End If
End Sub

Private Function setLastRow(ByRef rng As Range, ByVal lc As Long) As Long
   Dim ws As Worksheet, lr As Long
   If Not rng Is Nothing Then
      Set ws = rng.Parent
      lr = ws.Cells(rng.Row + ws.UsedRange.Rows.Count + 1, lc).End(xlUp).Row
      Set rng = ws.Range(ws.Cells(1, lc), ws.Cells(lr, lc)) 'updates rng (ByRef)
   End If
   setLastRow = lr
End Function

Public Sub xlEnabled(ByVal onOff As Boolean)
    Application.ScreenUpdating = onOff
    Application.EnableEvents = onOff
End Sub

2 of 2:

Private Function getDistinct(ByRef rng As Range, ByVal lr As Long) As String
   Dim ws As Worksheet, lst As String, lc As Long, tmp As Range

   Set ws = rng.Parent
   lc = ws.Cells(rng.Row, rng.Column + ws.UsedRange.Columns.Count + 1).End(xlToLeft).Column
   Set tmp = ws.Range(ws.Cells(1, lc + 1), ws.Cells(lr, lc + 1))

   If tmp.Count > 1 Then
      With tmp.Cells(1, 1)
         .Formula = "=Trim(" & ws.Cells(rng.Row, lc).Address(False, False) & ")"
         .AutoFill Destination:=tmp
      End With

      tmp.Value2 = tmp.Value2
      tmp.RemoveDuplicates Columns:=1, Header:=xlNo
      lr = setLastRow(tmp, lc + 1)

      ws.Sort.SortFields.Add Key:=ws.Cells(lr + 1, lc + 1), Order:=xlAscending
      With ws.Sort
         .SetRange tmp
         .Header = xlNo
         .MatchCase = False
         .Orientation = xlTopToBottom
      End With

      setLastRow tmp, lc + 1
      lst = Join(Application.Transpose(tmp), ",")
      tmp.Cells(1, 1).EntireColumn.Delete
   End If

   getDistinct = lst

End Function

Whenever you enter a new value (in any column)

  • The code turns off ScreenUpdating and Events (temporarily)
  • Any previous data validation for the current column will be removed
  • It determines the last used column on the sheet, and last cell with data in current column
  • It checks if the drop-down should be applied to the full column or just the cells with data

    • This option can be toggled by changing fullColumn As Boolean = True to False
  • Function getDistinct():

    • copies all values in current column to the first unused column on the sheet
    • this is not a normal copy\paste operation
    • it applies the TRIM() in the new column for all cells in current col
    • it then transforms the formula results to strings
    • applies RemoveDuplicates to only this new range
    • it applies sorting to the remaining list
    • determines list size again and converts the range to a string of items separated by commas
  • Sub setList() applies the list to a new validation rule that generates the drop-down

    • This validation rule can be deleted from Data > Data Validation (select column and Clear All)
  • It can be turned off by commenting out one line:


Private Sub Worksheet_Change(ByVal Target As Range)
   'If Target.Columns.Count = 1 Then setList Target
End Sub

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.