Multi-Select ListBox contents to Range

Question

Using VBA i have created a Userform with various Textboxes, Comboboxes & Listboxes. I currently set it so that once you hit the Submit button (Commandbutton1), the various boxes contents fill a selected cell on my sheet.

Private Sub CommandButton1_Click()

    Sheets("Sheet2").Range("D4") = TextBox1.Text
    Sheet2.Cells(5, 4) = ComboBox2.Text
    Sheet2.Cells(6, 4) = ComboBox1.Text
    Sheet2.Cells(7, 4) = TextBox2.Text
    Sheet2.Cells(8, 4) = TextBox4.Text

    UserForm1.Hide

End Sub

I also want the contents of my multiselect Listbox to do the same for cells (9, 4) - (15, 4) for example. How can i do this? The options on this multi select list box range from Insight, Barracuda, Siena, Visio, Project.

Robin Mackenzie Robin Mackenzie · Accepted Answer · 2017-08-18T10:59:48

You can iterate the selected items of the ListBox and add them to an array. When you have collected all the selected items, transfer to the Range. For example:

Private Sub CommandButton1_Click()

    ' your code
    Sheets("Sheet2").Range("C8") = TextBox1.Text
    Sheets("sheet2").Range("C12") = ComboBox2.Text
    Sheets("sheet2").Range("F12") = ComboBox1.Text
    Sheets("sheet2").Range("F8") = TextBox2.Text
    Sheets("sheet2").Range("F10") = TextBox4.Text
    Sheets("Sheet2").Range("C30") = TextBox7.Text
    Sheets("Sheet2").Range("F29:F36") = TextBox8.Text

    ' my code to update the sheet with the listbox selections
    Dim ws As Worksheet
    Dim rng As Range
    Dim lng1 As Long
    Dim lng2 As Long
    Dim str() As String

    Set ws = ThisWorkbook.Worksheets("Sheet2")
    Set rng = ws.Range("F22") ' (9, 4) - (15, 4)

    lng2 = 0 ' count of selected items
    For lng1 = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(lng1) Then
            lng2 = lng2 + 1 ' increment counter
            ReDim Preserve str(1 To lng2) ' resize array...
            str(lng2) = Me.ListBox1.List(lng1) ' and add selected item
        End If
    Next lng1

    ' transfer to range
    rng.Resize(lng2, 1).Value = Application.Transpose(str)

    ' close form
    'Unload Me
    UserForm1.Hide

End Sub

Multi-Select ListBox contents to Range

1 Answers