Multiple-Selection List Box That Retains Memory of Selections for Each Cell

[Tellenger]

Hi, everyone.

I'm looking for assistance with a multiple-selection list box being utilized to populate a selected cell with the selected choices and display previously selected items should the cell be selected again.

Currently, I've been able to create the list box which is populated with a list of items from a designated table and is activated upon clicking within a cell. Once a series of items are selected, pressing the "OK" button copies the selections to the cell using a comma as a delimiter. When clicking within this same cell, however, the list box displays the list of items but does not register the previous selected items that currently populate the cell resulting in those items being duplicated when selected again. Ideally, I'd like to be able to update the cell by checking and unchecking selections from within the list box.

Here is the code used to activate the list box upon clicking within a cell:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strList As String
On Error Resume Next
'temporarily turn off Events
Application.EnableEvents = False
'set a range with all DV cells on sheet
   Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
   On Error GoTo exitHandler
'if no DV cells, exit macro
   If rngDV Is Nothing Then GoTo exitHandler
   If Not Intersect(Target, rngDV) Is Nothing Then
  'if active cell IS in DV range
    'check if it's a List (DV type 3)
      If Target.Validation.Type = 3 And Cells(1, Target.Column) <> "Workgroup" And Cells(1, Target.Column) <> "Discipline" And Cells(1, Target.Column) <> "Position" Then
         'if list, get source list name
         strList = Target.Validation.Formula1
         strList = Right(strList, Len(strList) - 1)
         'pass source list name to global variable
         strDVList = strList
         'open UserForm
         frmDVList.Show
      End If
   End If

exitHandler:
'turn on Events
  Application.EnableEvents = True

End Sub

List Box Form Code:

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmdOK_Click()
Dim strSelItems As String
Dim lCountList As Long
Dim strSep As String
Dim strAdd As String
Dim bDup As Boolean
On Error Resume Next
strSep = ", "  'separator for items in cell

With Me.lstDV
  'go through all items in list
  '  numbering starts at zero
   For lCountList = 0 To .ListCount - 1
      'if item is selected, get item name
      '  strAdd variable is item name
      '     or empty string
      If .Selected(lCountList) Then
         strAdd = .List(lCountList)
      Else
         strAdd = ""
      End If
      
      'if no previous items,
      '  strSelItems =strAdd
      If strSelItems = "" Then
         strSelItems = strAdd
      Else
      'if prev items, add separator
      '  and latest item
         If strAdd <> "" Then
            strSelItems = strSelItems _
              & strSep & strAdd
         End If
      End If
   Next lCountList
End With

With ActiveCell
  'if active cell is not empty, add separator
  '  and all items collected from ListBox
   If .Value <> "" Then
      .Value = ActiveCell.Value _
        & strSep & strSelItems
   Else
   'if active cell empty, and all items
   '  collected from ListBox
      .Value = strSelItems
   End If
End With
Unload Me
End Sub

Private Sub lstDV_Click()

End Sub

Private Sub UserForm_Initialize()
   Me.lstDV.RowSource = strDVList
End Sub

Any help would be greatly appreciated!

 

[DanteAmor]

Hi and welcome to MrExcel.

Check if you can adapt the code of this post to your listbox, it does what you need and the code is already improved.

VBA for Listbox to current selected cell

Hi Ive been wondering, how to code a multi select Listbox that will pop-up when the cell is selected (like drop down list) and display the results in the same cell (separated by comma) This is the closest one I've found in a site...

www.mrexcel.com

 

[Tellenger]

Thank you for your reply, DanteAmor!

I'm extremely new to VBA coding and am struggling to understand the logic in the linked solution to be able to adapt it. In my source code above, I understand that by clicking in a cell, if first checks to see if the cell contains a data validation list and is not in a column with one of the listed headings. If this evaluates to TRUE, it then gets the data validation list and passes it to a global string and opens the form. Upon initialization, the form reads the global string and populates the list box.

I'm guessing that the code needs to evaluate the cell contents upon initialization and mark those items in the list as selected. The cmdOK_Click() code would then need to be able to evaluate the currently selected items against the cell contents and make any updates.

Am I thinking about this correctly?

 

[DanteAmor]

All that does the code. Share your file and I'll help you adapt it.

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[Tellenger]

Thanks, DanteAmor!

Here is the link to the file: Example Spreadsheet.xlsm

Let me know if you have any trouble accessing the file.

Columns "I" through "L" should generate the list box when clicking within the cell.

 

[DanteAmor]

Try this:

In the "modSettings" module the global variable is no longer needed:

Option Explicit
'Global strDVList As String

In the selectionchange event:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rngDV As Range
  Dim itm As Variant
  Dim i As Long
  
  Set rngDV = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
  If Target.CountLarge > 1 Then Exit Sub
  
  If Not Intersect(Target, rngDV) Is Nothing Then
    If Target.Validation.Type = 3 And Cells(1, Target.Column) <> "Workgroup" And Cells(1, Target.Column) <> "Discipline" And Cells(1, Target.Column) <> "Position" Then
      With frmDVList.lstDV
        .RowSource = Mid(Target.Validation.Formula1, 2)
        If Target.Value <> "" Then
          For Each itm In Split(Target.Value, ", ")
            For i = 0 To .ListCount - 1
              If .List(i) = itm Then
                .Selected(i) = True
              End If
            Next
          Next
        End If
        .Parent.Show
      End With
    End If
  End If
End Sub

In the userform:

Option Explicit

Private Sub cmdOK_Click()
  Dim gir As String
  Dim i As Long
  With Me.lstDV
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then gir = gir & .List(i) & ", "
    Next i
    If gir <> "" Then ActiveCell.Value = Left(gir, Len(gir) - 2) Else ActiveCell.Value = ""
  End With
  Unload Me
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

 

[Tellenger]

The code you provided, DanteAmor, worked perfectly. Thank you so much for taking the time to adapt the code. This is extremely helpful in understanding the VBA.