Active X listbox Multi-Select

[mothboy]

Hi,

I'm an absolute VBA novice and am stuck with some code that I've been give to output multi listbox selections into a single cell. I've searched for an age to find an explanation I can understand but failed miserably - please help me retain my sanity

Everything works well until the file is saved, on re-opening the check boxes in the list box have lost the selections (the output cell retains the original selections).

If someone could post back corrected code I would be your new bff, the code I'm using is as follows:


Private Sub ListBox1_Change()
'Output Cell
OutCell = "A1"


Dim outString As String, i As Long


outString = vbNullString
First = 0
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
If First = 0 Then
outString = .List(i)
First = 1
Else
outString = outString & ", " & .List(i)
End If
End If
Next i
End With
Range(OutCell).Value = outString


End Sub

 

[Norie]

Re: Active X listbox multi - please Heeeeeeeeeeeelllllllllllllllllllllllllpppppppppppppp

That code doesn't need corrected, you need more code to select the previously selected items in the listbox.

Where is the listbox located?

 

[mothboy]

Re: Active X listbox multi - please Heeeeeeeeeeeelllllllllllllllllllllllllpppppppppppppp

thanks Norie,

In the example I've been given it sits in sheet 1

 

[Norie]

Re: Active X listbox multi - please Heeeeeeeeeeeelllllllllllllllllllllllllpppppppppppppp

Try this, I've made a slight change to the code you posted - a space was getting in the way.

This Activate code will run when the sheet is activate, if that's not what you want it can be changed to run when the workbook opens.

Private Sub ListBox1_Change()
Dim outString As String, I As Long
Dim Outcell As String
Dim First As Long
    Outcell = "A1"
    outString = vbNullString
    With ListBox1
        For I = 0 To .ListCount - 1
            If .Selected(I) Then
                If First = 0 Then
                    outString = .List(I)
                    First = 1
                Else
                    outString = outString & "," & .List(I)
                End If
            End If
        Next I
    End With
    
    Range(Outcell).Value = outString
End Sub

Private Sub Worksheet_Activate()
Dim I As Long
Dim arrSelected
Dim ans As Variant
    Application.ScreenUpdating = False
    arrSelected = Split(Range("A1"), ",")
    For I = 0 To ListBox1.ListCount - 1
        ans = Application.Match(ListBox1.List(I), arrSelected, 0)
        If Not IsError(ans) Then
            ListBox1.Selected(I) = True
        End If
    Next I
    Application.ScreenUpdating = True
End Sub

 

[mothboy]

Re: Active X listbox multi - please Heeeeeeeeeeeelllllllllllllllllllllllllpppppppppppppp

Hi Norie,

I tried your code but I still seem to get the same issue (after save,close and re-open) the selected check boxes are blank (cell A1 is still populated with selected items). I replaced Worksheet _Activate with Worksheet_Open but it didn't solve the problem - is there any other info I can provide to give a better picture of what is happening?

Cheers

 

[Norie]

Re: Active X listbox multi - please Heeeeeeeeeeeelllllllllllllllllllllllllpppppppppppppp

Did you try going to another worksheet then activating the one with the listbox on it?

There's no Open event for the worksheet, do you want to put the code in the workbook's open event?

 

[mothboy]

Re: Active X listbox multi - please Heeeeeeeeeeeelllllllllllllllllllllllllpppppppppppppp

right,

I saved closed, reopened, went to sheet2, then back to sheet 1 and the check boxes were populated

so code is working but as you suggested above not quite what I need

If adding the code to the open event for the worksheet will make the check boxes populate on opening then that's exactly what I need- if you are able to show how that would be much appreciated.

 

[Norie]

Re: Active X listbox multi - please Heeeeeeeeeeeelllllllllllllllllllllllllpppppppppppppp

Remove the Activate code from the worksheet module and add this code to the ThisWorkbook module.

Option Explicit
Private Sub Workbook_Open()
Dim I As Long
Dim arrSelected
Dim ans As Variant
    Application.ScreenUpdating = False
    
    arrSelected = Split(Sheet1.Range("A1"), ",")
    
    For I = 0 To Sheet1.ListBox1.ListCount - 1
         ans = Application.Match(Sheet1.ListBox1.List(I), arrSelected, 0)
         If Not IsError(ans) Then
            Sheet1.ListBox1.Selected(I) = True
         End If
    Next I
    
    Application.ScreenUpdating = True
    
End Sub

 

[mothboy]

Re: Active X listbox multi - please Heeeeeeeeeeeelllllllllllllllllllllllllpppppppppppppp

excellent

it's looking great.

Just one last hiccup - I get a:

run-time error 13: type mismatch

when none of the items on the list are selected.

Error is displayed on re-opening after a save.

Is it possible to fix that?

thanks so much for all the help so far - this is making my day!

 

[Norie]

Re: Active X listbox multi - please Heeeeeeeeeeeelllllllllllllllllllllllllpppppppppppppp

You need to test if there is anything in A1, if there isn't exit the sub.

' check if A1 is empty
If Sheet1.Range("A1").Value = "" Then Exit Sub

arrSelected = Split(Sheet1.Range("A1"), ",")