Excel list box Multi select linked cell

The solution I came up with does change the look of your listbox somewhat. You were using an ActiveX listbox that gives you the nice-looking checkboxes for your multiselect. The problem I had was assigning a macro to a listbox to catch the OnAction event (each time you click on a listbox item). My solution below works with Forms Listboxes. There are a few parts to the solution.

You stated a requirement that when the user selects a cell in the "Colours" column, a listbox pops up and presents the list of color options. To achieve this, I used the Worksheet_SelectionChange event in the worksheet module:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub Dim colourRange As Range Set colourRange = ColourArea(ActiveSheet) If colourRange Is Nothing Then Exit Sub If Not Intersect(Target, colourRange) Is Nothing Then CreateColourPopUp Target Else DeleteAllPopUps Target End If End Sub

What's important to note here is that the popup is created anytime the user selects a cell in the "Colours" column and whenever a cell is selected outside of that range, the popup is deleted. The ColourArea is defined in a separate module (with all the other code in this answer Module1):

Public Function ColourArea(ByRef ws As Worksheet) As Range '--- returns a range for the colour selections for all the products ' currently active on the worksheet Const COLOUR_COL As Long = 6 Dim lastRow As Long With ws lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 Set ColourArea = .Cells(2, COLOUR_COL).Resize(lastRow, 1) End With End Function

I coded this as separate from the Worksheet_SelectionChange because you may now, or in the future, use some other way to determine what range on the worksheet is used for your colors.

Creating the popup then happens in the code here, where the listbox is created in the cell just below the selected cell. Note again that determining the range that contains the list of colors is encapsulated in a function.

Public Function ColourListArea() As Range Set ColourListArea = Sheet1.Range("M1:M11") End Function Public Sub DeleteAllPopUps(ByRef selectedCell As Range) Dim colourBox As ListBox For Each colourBox In selectedCell.Parent.ListBoxes colourBox.Delete Next colourBox End Sub Public Sub CreateColourPopUp(ByRef selectedCell As Range) Set colourSelectCell = selectedCell Dim popUpCell As Range Set popUpCell = colourSelectCell.OFFSET(1, 0) DeleteAllPopUps selectedCell '--- now create the one we need, right below the selected cell Const POPUP_WIDTH As Double = 75 Const POPUP_HEIGHT As Double = 110 Const OFFSET As Double = 5# Dim colourBox As ListBox Set colourBox = ActiveSheet.ListBoxes.Add(popUpCell.left + OFFSET, _ popUpCell.top + OFFSET, _ POPUP_WIDTH, _ POPUP_HEIGHT) With colourBox .ListFillRange = ColourListArea().Address .LinkedCell = "" .MultiSelect = xlSimple .Display3DShading = True .OnAction = "Module1.ColourBoxClick" End With '--- is there an existing list of colours selected? Dim selectedColours() As String selectedColours = Split(colourSelectCell.Value, ",") Dim colour As Variant For Each colour In selectedColours Dim i As Long For i = 1 To colourBox.ListCount If colourBox.List(i) = colour Then colourBox.Selected(i) = True Exit For End If Next i Next colour End Sub

The variable colourSelectCell is declared at the module-global level (see the full module at the end of this post). You will likely have to manually adjust the width and height constants as needed.

Finally, the OnAction routine is defined as:

Public Sub ColourBoxClick() Dim colourBoxName As String colourBoxName = Application.Caller Dim colourBox As ListBox Set colourBox = ActiveSheet.ListBoxes(colourBoxName) Dim colourList As String Dim i As Long For i = 1 To colourBox.ListCount If colourBox.Selected(i) Then colourList = colourList & colourBox.List(i) & "," End If Next i If Len(colourList) > 0 Then colourList = Left$(colourList, Len(colourList) - 1) End If colourSelectCell.Value = colourList End Sub

This is where the global colourSelectCell is used.

The entire Module1 is

Option Explicit Private colourSelectCell As Range Public Function ColourArea(ByRef ws As Worksheet) As Range Const COLOUR_COL As Long = 6 '--- returns a range for the colour selections for all the products ' currently active on the worksheet Dim lastRow As Long With ws lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 If lastRow = 0 Then Set ColourArea = Nothing Else Set ColourArea = .Cells(2, COLOUR_COL).Resize(lastRow, 1) End With End Function Public Sub ColourBoxClick() Dim colourBoxName As String colourBoxName = Application.Caller Dim colourBox As ListBox Set colourBox = ActiveSheet.ListBoxes(colourBoxName) Dim colourList As String Dim i As Long For i = 1 To colourBox.ListCount If colourBox.Selected(i) Then colourList = colourList & colourBox.List(i) & "," End If Next i If Len(colourList) > 0 Then colourList = Left$(colourList, Len(colourList) - 1) End If colourSelectCell.Value = colourList End Sub Public Function ColourListArea() As Range Set ColourListArea = Sheet1.Range("M1:M11") End Function Public Sub DeleteAllPopUps(ByRef selectedCell As Range) Dim colourBox As ListBox For Each colourBox In selectedCell.Parent.ListBoxes colourBox.Delete Next colourBox End Sub Public Sub CreateColourPopUp(ByRef selectedCell As Range) Set colourSelectCell = selectedCell Dim popUpCell As Range Set popUpCell = colourSelectCell.OFFSET(1, 0) DeleteAllPopUps selectedCell '--- now create the one we need, right below the selected cell Const POPUP_WIDTH As Double = 75 Const POPUP_HEIGHT As Double = 110 Const OFFSET As Double = 5# Dim colourBox As ListBox Set colourBox = ActiveSheet.ListBoxes.Add(popUpCell.left + OFFSET, _ popUpCell.top + OFFSET, _ POPUP_WIDTH, _ POPUP_HEIGHT) With colourBox .ListFillRange = ColourListArea().Address .LinkedCell = "" .MultiSelect = xlSimple .Display3DShading = True .OnAction = "Module1.ColourBoxClick" End With '--- is there an existing list of colours selected? Dim selectedColours() As String selectedColours = Split(colourSelectCell.Value, ",") Dim colour As Variant For Each colour In selectedColours Dim i As Long For i = 1 To colourBox.ListCount If colourBox.List(i) = colour Then colourBox.Selected(i) = True Exit For End If Next i Next colour End Sub

EDIT: here's an example of returned a discontiguous range of cells to allow the popups. ALSO -- add the line If Target.Cells.Count > 1 Then Exit Sub as shown to the Worksheet_SelectionChange sub so that you don't get errors selecting more than one cell.

Public Function ColourArea(ByRef ws As Worksheet) As Range Const COLOUR_COL As Long = 6 Const PRODUCT_ROWS As Long = 16 '--- returns a range for the colour selections for all the products ' currently active on the worksheet Dim lastRow As Long With ws lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row If lastRow = 0 Then ColourArea = Nothing Else Dim numberOfProducts As Long numberOfProducts = (lastRow - 1) / PRODUCT_ROWS '--- now create a Union of the first row of each of these ' product areas Dim firstRow As Range Dim allFirsts As Range Set firstRow = ws.Cells(2, COLOUR_COL) Set allFirsts = firstRow Dim i As Long For i = 2 To numberOfProducts Set firstRow = firstRow.OFFSET(PRODUCT_ROWS, 0) Set allFirsts = Application.Union(allFirsts, firstRow) Next i Set ColourArea = allFirsts End If End With End Function

• Dear all,

  I refer to the following article from last year, with a similar question.
  http://www.ozgrid.com/forum/showthread.php?t=37672

  I would like to be able to choose multiple values from a list box and print them into one cell (or at least print them anywhere).

  For example: I have a list with products A, B, C, D, E, F
  Those products are shown in the list box. If e.g. B, D and E are chosen, I would like to have this selection shown together in another cell. That means the content of the cell should be "B, D, E".

  If I use the INDEX function (which works fine for single select list boxes), only one of the selected items is displayed in the cell and not even the one I selected.

  How do I get all of them (in one or in separate cells)??

  Thanks for you time and effort! I really appreciate that!

• Re: Multiple List Box Selection - Fill Into One Cell

  Try this for writing all selected values in one cell...

  Sub Test_FunctionArea1() Dim i, TmpList As String TmpList = "" For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then TmpList = TmpList & " " & ListBox1.List(i) End If Next i MsgBox TmpList 'to know ActiveCell = TmpList 'to type all in one cell End Sub Display More

• Re: Multiple List Box Selection - Fill Into One Cell

  Thanks a lot for your quick reply, ilyaskazi! Yet, this is bit complicated for my limited Excel-skills. Therefore, please excuse this basic questions.

  Am I right, that I proceed the following:

  - create ListBox (as control, not as form)- define properties: list fill range (the cells with products A-F) cell link (one cell) Multi-Select: fmMultiSelectMulti BoundColumn: 1 ColumnCount:1

  - create Button (Forms) assigned with the code by ilyaskazi

Now, what did I miss? (probably a lot...). Is ilyaskazi's code complete or just a structure, which I have to fill?

Newly created posts will remain inaccessible for others until approved by a moderator.

The last reply was more than 180 days ago, this thread is most likely obsolete. It is recommended to create a new thread instead.