1

I need to find a way to display several values in one cell. I also found a solution by the post of 'L42' (https://stackoverflow.com/a/23319627/10506941)

This is the current code I am using:

Option Explicit
Dim fillRng As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Countries As MSForms.ListBox
Dim LBobj As OLEObject
Dim i As Long

Set LBobj = Me.OLEObjects("Countries")
Set Countries = LBobj.Object

    If Not Intersect(Target, [AT:BB]) Is Nothing Then
        Set fillRng = Target
        With LBobj
            .Left = fillRng.Left
            .Top = fillRng.Top
            .Width = fillRng.Width
            .Visible = True
        End With
    Else
        LBobj.Visible = False
        If Not fillRng Is Nothing Then
            With Countries
                If .ListCount <> 0 Then
                    For i = 0 To .ListCount - 1
                        If fillRng.Value = "" Then
                            If .Selected(i) Then fillRng.Value = .List(i)
                        Else
                            If .Selected(i) Then fillRng.Value = _
                                fillRng.Value & "," & .List(i)
                        End If
                    Next
                End If
                For i = 0 To .ListCount - 1
                    .Selected(i) = False
                Next
            End With
            Set fillRng = Nothing
        End If
    End If

End Sub

This is definitely the way I wanted to do it. But I have some problems:

  • The values won't adapt untill I click another cell abroad the column AT to BB.
  • Changing cells deletes the selected values. Is there a way to regocnize the values in a cell and mark them as already selected?
  • The code is always adding the values after changing to another cell. Is there a way to not allow duplicates?

Can someone help me? I am new to this topic and I have no clues anymore :/

1 Answer 1

1

My solution builds from your example with some changes to validate the data and initialize the listbox. The setup follows the examples and defines a list of countries in a named range, then creates a ListBox that uses the range with multi-select.

enter image description here

In response to your question "The values won't adapt untill I click another cell abroad the column AT to BB", this is the way the action is designed. You won't know that the user has finished checking boxes until they select another cell. This is an expected action.

I've made several changes to your code. The first is to check the Target range to make sure there is only one cell selected. You can get into an unknown state if there are multiple selected cells and the code runs.

'--- we can only do one at a time
If Target.Cells.Count > 1 Then Exit Sub

Next, I'm not assuming that the selected cell is empty. It can very possibly contain a list of countries previously selected and added to the cell. So there is a private routine that will check the cell for a list, and then use that list to re-select items in the listbox.

Private Sub SelectListBoxItems(ByRef thisListBox As MSForms.ListBox, _
                               ByRef valueList As Variant)
    If UBound(valueList, 1) > 0 Then
        Dim i As Long
        Dim j As Long
        With thisListBox
        For i = 0 To .ListCount - 1
            For j = LBound(valueList, 1) To UBound(valueList, 1)
                If .List(i) = valueList(j) Then
                    .Selected(i) = True
                End If
            Next j
        Next i
        End With
    End If
End Sub

So in the main SelectionChange sub, the code looks like this:

If Not Intersect(Target, [B:C]) Is Nothing Then
    Set fillRng = Target
    With LBobj
        .Left = fillRng.Left
        .Top = fillRng.Top
        .Width = fillRng.Width
        Dim valueList As Variant
        SelectListBoxItems countriesListBox, Split(fillRng, ",")
        .Visible = True
    End With

Finally, make sure the clear the underlying cell before (re-)adding the list of selections.

Here is the whole code module:

Option Explicit

Private fillRng As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    '--- we can only do one at a time
    If Target.Cells.Count > 1 Then Exit Sub

    Dim LBobj As OLEObject
    Set LBobj = Me.OLEObjects("LB_colors")

    Dim countriesListBox As MSForms.ListBox
    Set countriesListBox = LBobj.Object

    If Not Intersect(Target, [B:C]) Is Nothing Then
        Set fillRng = Target
        With LBobj
            .Left = fillRng.Left
            .Top = fillRng.Top
            .Width = fillRng.Width
            Dim valueList As Variant
            SelectListBoxItems countriesListBox, Split(fillRng, ",")
            .Visible = True
        End With
    Else
        LBobj.Visible = False
        If Not fillRng Is Nothing Then
            fillRng.Value = vbNullString
            With countriesListBox
                If .ListCount <> 0 Then
                    Dim i As Long
                    For i = 0 To .ListCount - 1
                        If fillRng.Value = vbNullString Then
                            If .Selected(i) Then fillRng.Value = .List(i)
                        Else
                            If .Selected(i) Then fillRng.Value = _
                               fillRng.Value & "," & .List(i)
                        End If
                    Next
                End If
                For i = 0 To .ListCount - 1
                    .Selected(i) = False
                Next
            End With
            Set fillRng = Nothing
        End If
    End If

End Sub

Private Sub SelectListBoxItems(ByRef thisListBox As MSForms.ListBox, _
                               ByRef valueList As Variant)
    If UBound(valueList, 1) > 0 Then
        Dim i As Long
        Dim j As Long
        With thisListBox
        For i = 0 To .ListCount - 1
            For j = LBound(valueList, 1) To UBound(valueList, 1)
                If .List(i) = valueList(j) Then
                    .Selected(i) = True
                End If
            Next j
        Next i
        End With
    End If
End Sub
Sign up to request clarification or add additional context in comments.

1 Comment

Thank you PeterT. You helped me out a lot, but I can't vote for your response, becaues I am new ...

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.