Checkboxes to create lists

[bdrot88]

Hi All,

Can anyone suggest a way to create a list in a cell which is generated by checking checkboxes in a userform. Something along the line of (not in syntax!):

for cell b3 - if checkbox 1 == true - inset "word1", if checkbox 2 == true - inset "word2" etc.

Essentially what I'm after is to have 10 checkboxes to create a list of the checked items in a cell on pressing the submit button.

thanks for any help!!

[MickG]

Place this code in a command button on your userform.
Results in column "A"

Private Sub CommandButton1_Click()
Dim Ctrl As Control
ReDim Ray(0 To 9)
Dim c As Integer
For Each Ctrl In Me.Controls
    If TypeName(Ctrl) = "CheckBox" And Ctrl = True Then
        Ray(c) = "Word" & Ctrl.TabIndex + 1
        c = c + 1
    End If
Next Ctrl
Range("A1").Resize(c - 1) = Application.Transpose(Ray)
End Sub

[bdrot88]

Hi Mick,

thanks for your response, but the debugger is finding a problem with line 6 of your code (not sure what to amend in relation to my sheet) and I think this is going to be easier with a multi-select list box on second thought.

However,

not sure how to get the selected options to output into a cell. I'm trying the code in the submit button sub which is working for all combo boxes and text fields but simply doesn't output the results of the list box for some reason:

We're looking at row 16 (listbox1)

Private Sub CommandButton1_Click()
Dim ssheet As Worksheet

Set ssheet = ThisWorkbook.Sheets("Main")

nr = ssheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

ssheet.Cells(nr, 1) = Me.mainDateReciev
ssheet.Cells(nr, 2) = Me.mainName
ssheet.Cells(nr, 3) = Me.mainOrg
ssheet.Cells(nr, 4) = Me.mainOrgType
ssheet.Cells(nr, 5) = Me.mainSubject
ssheet.Cells(nr, 6) = Me.mainType
ssheet.Cells(nr, 7) = Me.mainDateReply
ssheet.Cells(nr, 8) = Me.mainReplyDrop
ssheet.Cells(nr, 9) = Me.mainDateEvent
ssheet.Cells(nr, 10) = Me.mainEventType
ssheet.Cells(nr, 11) = Me.mainEventLocation
ssheet.Cells(nr, 12) = Me.mainQuest
ssheet.Cells(nr, 13) = Me.mainEventDecision
ssheet.Cells(nr, 14) = Me.mainProgress
ssheet.Cells(nr, 15) = Me.mainCode
ssheet.Cells(nr, 16).Value = Me.ListBox1
ssheet.Cells(nr, 17) = Me.mainAction
ssheet.Cells(nr, 18) = Me.mainStatus
ssheet.Cells(nr, 19) = Me.mainLink
ssheet.Cells(nr, 20) = Me.mainBringForw

Unload Me

End Sub

any thoughts?

[MickG]

You need to set your listbox to "Multiselect", and using code basically as below, place the selected items on the sheet.

Private Sub CommandButton2_Click()
Dim n As Long
Dim c As Long
c = 1
With Me.ListBox1
    For n = 0 To .ListCount - 1
        If .Selected(n) Then
            c = c + 1
            Cells(1, c) = .List(n)
        End If
    Next n
End With
End Sub

[bdrot88]

Hi Mick,

not 100% on what would need to be edited in your code to refer to my data, I've guessed and swapped a few things out but returns an error each time.

Below is the full UserForm code so that you can see what I'm working with and trying to achieve.

Private Sub UserForm_Initialize()
Me.mainDateReciev = Date

Me.mainOrgType.AddItem "Retailer"
Me.mainOrgType.AddItem "Supplier"
Me.mainOrgType.AddItem "Trade Association"
Me.mainOrgType.AddItem "Government"
Me.mainOrgType.AddItem "Other"

Me.mainType.AddItem "Event"
Me.mainType.AddItem "Meeting"
Me.mainType.AddItem "Visit"
Me.mainType.AddItem "Issue"
Me.mainType.AddItem "Media"

Me.mainReplyDrop.AddItem "Holding"
Me.mainReplyDrop.AddItem "Further Enquiry"
Me.mainReplyDrop.AddItem "Completed"

Me.mainEventType.AddItem "Dinner"
Me.mainEventType.AddItem "Conference"
Me.mainEventType.AddItem "Speech"
Me.mainEventType.AddItem "Attending"

Me.mainQuest.AddItem "Yes"
Me.mainQuest.AddItem "No"

Me.mainEventDecision.AddItem "Accept"
Me.mainEventDecision.AddItem "Decline"

Me.mainCode.AddItem "Fair Dealing"
Me.mainCode.AddItem "Variation of Supply Agreements"
Me.mainCode.AddItem "Payment on time"
Me.mainCode.AddItem "Marketing costs"
Me.mainCode.AddItem "Shrinkage"
Me.mainCode.AddItem "Wastage"
Me.mainCode.AddItem "Listing fees"
Me.mainCode.AddItem "Forecasting errors"
Me.mainCode.AddItem "Third party suppliers"
Me.mainCode.AddItem "Shelf positioning"
Me.mainCode.AddItem "Funding promotions"
Me.mainCode.AddItem "Promotion-over order"
Me.mainCode.AddItem "Customer complaints"
Me.mainCode.AddItem "Delisting"

Me.mainStatus.AddItem "Open"
Me.mainStatus.AddItem "Closed"
Me.mainStatus.AddItem "Pending"

Me.ListBox1.AddItem "Tesco"
Me.ListBox1.AddItem "Co-op"
Me.ListBox1.AddItem "Sainsburys"
Me.ListBox1.AddItem "Lidl"
Me.ListBox1.AddItem "Aldi"
Me.ListBox1.AddItem "Asda"
Me.ListBox1.AddItem "Morrisons"
Me.ListBox1.AddItem "Waitrose"
Me.ListBox1.AddItem "M&S"
Me.ListBox1.AddItem "Iceland"
        
End Sub


Private Sub CommandButton1_Click()
Dim ssheet As Worksheet

Set ssheet = ThisWorkbook.Sheets("Main")

nr = ssheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

ssheet.Cells(nr, 1) = Me.mainDateReciev
ssheet.Cells(nr, 2) = Me.mainName
ssheet.Cells(nr, 3) = Me.mainOrg
ssheet.Cells(nr, 4) = Me.mainOrgType
ssheet.Cells(nr, 5) = Me.mainSubject
ssheet.Cells(nr, 6) = Me.mainType
ssheet.Cells(nr, 7) = Me.mainDateReply
ssheet.Cells(nr, 8) = Me.mainReplyDrop
ssheet.Cells(nr, 9) = Me.mainDateEvent
ssheet.Cells(nr, 10) = Me.mainEventType
ssheet.Cells(nr, 11) = Me.mainEventLocation
ssheet.Cells(nr, 12) = Me.mainQuest
ssheet.Cells(nr, 13) = Me.mainEventDecision
ssheet.Cells(nr, 14) = Me.mainProgress
ssheet.Cells(nr, 15) = Me.mainCode

ssheet.Cells(nr, 17) = Me.mainAction
ssheet.Cells(nr, 18) = Me.mainStatus
ssheet.Cells(nr, 19) = Me.mainLink
ssheet.Cells(nr, 20) = Me.mainBringForw

Dim n As Long
Dim c As Long
c = 1
With Me.ListBox1
    For n = 0 To .ListCount - 1
        If .Selected(n) Then
            c = c + 1
            Cells(1, c) = .List(n)
        End If
    Next n
End With

Unload Me

End Sub

[bdrot88]

Don't worry Mike, I've sussed it :D Thanks very much for your input anyway!

Dim strListBox$, i%
strListBox = ""
With Worksheets("Main")
srNextRow = ssheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then strListBox = strListBox & ListBox1.List(i) & ", "
Next i
If Len(strListBox) > 0 Then
strListBox = Mid(strListBox, 1, Len(strListBox) - 1)
.Cells(srNextRow, 16).Value = strListBox
Else
MsgBox "Please select a supplier.", , "Nothing to transfer."
End If
End With

[MickG]

Good news !!!
Regrds Mick