Making Multiple Selections from an Excel Drop Down List

It's widely known that Excel's Data Validation tool can be used to create a drop down list for all cells in a selected range. You'll simply be able to click on an down arrow next to a cell and select the entry. This feature can speed up a lengthy manual review of documentation tracked on a spreadsheet. Tonight's tip will show how you can use VBA code to change this tool to allow for multiple entries from the list to be saved in a cell.


To get started follow these steps:


1. Select the data range you want the 'pick list' to be available for.

2. Go to Data . . . Data Validation


3. In the dialog box on the Settings tab, choose 'List' from the Allow menu. Then click on the arrow next to the Source box to select the data range which will contain the entries you want to appear in the drop down list. The entries can be listed on a different worksheet.



If you have to add more items to the list as you go along, check off the box labeled, 'Apply these changes to all other cells with the same settings', and then expand the source range.


4. This will give you a drop down list that will let you select any one of the entries for the cell. If you select a second entry, the first entry will be overwritten.




You can use VBA code posted here, and modified below to make it possible to select multiple entries. The modified version lets you clear the cell after entries have been made (thanks to Susan Lynn for her suggestion); leaves the first entry you select at the beginning of the cell; and puts each new entry on a new line.


On this line of the VBA code you can set the delimiter you want to use between the entries.


xStrNew = " " & Target.Value & Chr(10)


In my version of the code I've entered the Chr(10) reference to put each new entry on a separate line. If 'Chr(10)' is changed to "; " each new entry will be separated with a semi-colon.


In order to clear a cell, select it and choose 'Clear Contents' from the right click menu.






Private Sub Worksheet_Change(ByVal Target As Range)

'UpdatebyExtendoffice20180510

Dim I As Integer

Dim xRgVal As Range

Dim xStrNew As String

Dim xStrOld As String

Dim xFlag As Boolean

Dim xArr

On Error Resume Next

Set xRgVal = Cells.SpecialCells(xlCellTypeAllValidation)

If (Target.Count > 1) Or (xRgVal Is Nothing) Then Exit Sub

If Intersect(Target, xRgVal) Is Nothing Then Exit Sub

Application.EnableEvents = False

xFlag = True

xStrNew = " " & Target.Value & Chr(10)

Application.Undo

xStrOld = Target.Value

If InStr(1, xStrOld, xStrNew) = 0 Then

xStrNew = xStrOld & xStrNew

Else

xStrNew = ""

End If

Target.Value = xStrNew

Application.EnableEvents = True

End Sub