ListBox Copying only first selection to worksheet

[zdodson]

All:

I have a listbox that is populated by a dynamic range from another sheet. The listbox has (1) command button. Once that command button is selected, it "grabs" the selected lines of record and adds them to a worksheet so those records can be assigned. Below is my code that I am working through:

Private Sub cmdAssign_Click()


Dim addme As Range
Dim x As Integer, Ck As Integer


Set addme = Sheet9.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Ck = 0


'Run the loop
    For x = 0 To listMulti.ListCount - 1
    'Add conditional statement
        If Me.listMulti.Selected(x) Then
        Ck = 1
        
        addme = Me.listMulti.List(x)
        addme.Offset(0, 1) = Me.listMulti.List(x, 1)
        addme.Offset(0, 2) = Me.listMulti.List(x, 2)
        addme.Offset(0, 3) = Me.listMulti.List(x, 3)
        addme.Offset(0, 4) = Me.listMulti.List(x, 4)
        addme.Offset(0, 5) = Me.listMulti.List(x, 5)
        addme.Offset(0, 6) = Me.listMulti.List(x, 8)
        addme.Offset(0, 7) = Me.listMulti.List(x, 9)
        addme.Offset(0, 8) = Me.listMulti.List(x, 12)
        addme.Offset(0, 9) = Me.listMulti.List(x, 13)
        addme.Offset(0, 10) = Me.listMulti.List(x, 14)
        addme.Offset(0, 11) = Me.listMulti.List(x, 15)
        addme.Offset(0, 12) = Me.listMulti.List(x, 16)


        
        Set addme = addme.Offset(1, 0)


        'Clear the selected values
        listMulti.Selected(x) = False
        
        End If
      Next x
    
    'Send a message if nothing is selected
    If Ck = 0 Then
        MsgBox "Nothing is selcted"
    End If

End Sub

As it stands now, only the first selection I make out of the listbox is populating in the worksheet I want to "drop" the data in. Ideally, I want to drop all of the selected rows of data into the worksheet.

Any guidance on this one?

 

[Yongle]

Try this:

Private Sub cmdAssign_Click()
    Dim LastRow As Long, x As Long, ck As Long
    For x = 0 To ListMulti.ListCount - 1
        If ListMulti.Selected(x) Then
            ck = ck + 1
            With Sheet9
                LastRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
                    .Cells(LastRow, 1) = ListMulti.Column(0, x)
                    .Cells(LastRow, 2) = ListMulti.Column(1, x)
                    .Cells(LastRow, 3) = ListMulti.Column(2, x)
                    .Cells(LastRow, 4) = ListMulti.Column(3, x)
                    'etc
                    ListMulti.Selected(x) = False
            End With
        End If
    Next x
    If ck = 0 Then MsgBox "Nothing selected"
End Sub

 

[Yongle]

to avoid repeating same line 13 times...

Private Sub cmdAssign_Click()
    Dim LastRow As Long, x As Long, ck As Long, [COLOR=#006400]c[/COLOR] As Long, [COLOR=#0000cd]e[/COLOR] As Variant
    For x = 0 To ListMulti.ListCount - 1
        If ListMulti.Selected(x) Then
            ck = ck + 1
            With Sheet9
                [COLOR=#006400]c[/COLOR] = 0
                LastRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
                    For Each [COLOR=#0000cd]e[/COLOR] In Array(0, 1, 2, 3, 4, 5, 8, 9, 12, 13, 14, 15, 16)
                        [COLOR=#006400]c[/COLOR] = c + 1
                        [COLOR=#ff0000].Cells(LastRow, [/COLOR][COLOR=#006400]c[/COLOR][COLOR=#ff0000]) = ListMulti.Column([/COLOR][COLOR=#0000cd]e[/COLOR][COLOR=#ff0000], x)[/COLOR]
                    Next [COLOR=#0000cd]e[/COLOR]
                    ListMulti.Selected(x) = False
            End With
        End If
    Next x
    If ck = 0 Then MsgBox "Nothing selected"
End Sub

 

[zdodson]

Attempted to use this code, but I am running into the same issues as stated above whereby it will only carry over my first selection from the listbox.

 

[Yongle]

The code was tested and works with my listbox

Please confirm that listbox MultiSelect property is set to fmMultiSelectMulti

(If that is not the issue) is the listbox on a userform or active-x object in worksheet?