setting defaults for multiselect listboxes

[oli merge]

Hi,

I have some listboxes with multiselect enabled on a form I am working on. I
want them to default to all options checked, but let the user alter them and
save the changes, send it to me and me still be able to see what they have
changed.

I currently have a macro that sets all values to checked on the workbook
open event, which is no good because any changes the user makes are lost when
I reopen it.

I have tried using the linkedcell property to set them to a range, but dont
really understand how to do this, the values of the range seem to have no
effect on the values of the checkbox.

Any suggestions?

Thanks.

 

[Dave Peterson]

If only one user opens the workbook, maybe you can have a (hidden) worksheet
that keeps track of the selected items.

Then each time you open the workbook, you can read the entries in that worksheet
and show the listbox the way you want.

Remember that you'll have to update the list (which means that you'll have to
save the workbook!) before it's closed.

If the list never changes, I'd use two columns--the first for the value you see
in the listbox and the second to indicate whether it's selected.

I created a small userform with a couple of commandbuttons and a listbox on it.
I added a worksheet named Hidden to my workbook and put some test data in
A1:B10.

Then I used this code behind the userform:

Option Explicit
Private Sub CommandButton1_Click()
'cancel button
Unload Me
End Sub
Private Sub CommandButton2_Click()
'Save Button
Dim HWks As Worksheet
Dim cCtr As Long
Dim myRng As Range

Set HWks = Worksheets("Hidden")

With HWks
Set myRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

With Me.ListBox1
For cCtr = 0 To .ListCount - 1
myRng.Cells(1).Offset(cCtr, 1).Value = .Selected(cCtr)
Next cCtr
End With

On Error Resume Next
ThisWorkbook.Save
If Err.Number <> 0 Then
Err.Clear
MsgBox "Save Failed!!!"
Else
MsgBox "Data Saved"
End If

'Unload Me 'done???

End Sub
Private Sub UserForm_Initialize()
Dim HWks As Worksheet
Dim cCtr As Long
Dim myRng As Range

Set HWks = Worksheets("Hidden")

With HWks
Set myRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

With Me.ListBox1
.MultiSelect = fmMultiSelectMulti
.ColumnCount = 1
.ListStyle = fmListStyleOption

'put the list in the listbox
.List = myRng.Value 'all at once

For cCtr = 0 To .ListCount - 1
.Selected(cCtr) = CBool(myRng.Cells(1).Offset(cCtr, 1).Value)
Next cCtr
End With

With Me.CommandButton1
.Caption = "Cancel"
.Enabled = True
.Cancel = True
End With

With Me.CommandButton2
.Enabled = True
.Caption = "Save The Current Selected Items"
End With

End Sub

 

[oli merge]

Hi Dave,

Thanks for the reply.

Keeping track of the items on a hidden worksheet sounds ideal. I have been
trying to implement your code without a userform but I dont think I am doing
it correctly. I tried moving the userform intialise code to workbook open
event, replaced the 'me' keyword with activesheet but keep getting "Runtime
Error 381: Could not set the list property Invalid Property Array".

Would this be achievable without a userform or should I just admit defeat?


Thanks!

 

[Dave Peterson]

In the ThisWorkbook module:

Option Explicit
Private Sub Workbook_Open()
Dim HWks As Worksheet
Dim cCtr As Long
Dim myRng As Range
Dim LBWks As Worksheet

Set HWks = Me.Worksheets("Hidden")

Set LBWks = Me.Worksheets("Sheet1") '<-- sheet with listbox

With HWks
Set myRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

With LBWks.OLEObjects("ListBox1").Object
.MultiSelect = fmMultiSelectMulti
.ColumnCount = 1
.ListStyle = fmListStyleOption

'put the list in the listbox
.List = myRng.Value 'all at once

For cCtr = 0 To .ListCount - 1
.Selected(cCtr) = CBool(myRng.Cells(1).Offset(cCtr, 1).Value)
Next cCtr
End With

With LBWks.OLEObjects("CommandButton1").Object
.Enabled = True
.Caption = "Save The Current Selected Items"
End With

End Sub


In the worksheet module that holds the listbox named "listbox1" and a
commandbutton named "commandbutton1"

Option Explicit
Private Sub CommandButton1_Click()
'Save Button
Dim HWks As Worksheet
Dim cCtr As Long
Dim myRng As Range

Set HWks = Worksheets("Hidden")

With HWks
Set myRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

With Me.ListBox1
For cCtr = 0 To .ListCount - 1
myRng.Cells(1).Offset(cCtr, 1).Value = .Selected(cCtr)
Next cCtr
End With

On Error Resume Next
Me.Parent.Save
If Err.Number <> 0 Then
Err.Clear
MsgBox "Save Failed!!!"
Else
MsgBox "Data Saved"
End If

End Sub

 

[oli merge]

Thanks for your help once again.

The Save button works brilliantly, its just the retrieve items that is still
giving me the "Runtime Error 381: Could not set the list property Invalid
Property Array" on the line:

..List = myRng.Value

Could this be to do with the way I have setup the listbox?

 

[oli merge]

O sorry, my mistake, if I remove that line the loop underneath it populates
the listbox ok anyway. Was that line for singe select listboxes or something?

Thanks again, problem solved.

 

[Dave Peterson]

It worked ok for me in my testing.

But my bet is that you assigned the listfillrange manually and the code couldn't
do what it wanted. Remove the listfillrange (empty that field) and put the code
back.

It'll be safer if the values in the listbox change.