CODEWITHSUNDEEP
excelvbacheckboxexcel-2016
KenneyStone
KenneyStone

Reputation: 13

VBA - Checkbox for multiple values in a cell in Excel 2016

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:

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

Upvotes: 1

Views: 668

Answers (1)

PeterT
PeterT

Reputation: 8557

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

Upvotes: 1

Related Questions