UserForm with 5 Listboxes to drop selections in worksheet.

[DThib]

New day, new challenge

I am creating 5 listboxes in a userform with data in 1 column each. I need to have these populate a worksheet from selected items and place selection in a worksheet in a column. It does drop these into a building column, but the data is wrong.
The problem is, as of now, they are copying the selection row/level choices from the first listbox into the responses for the others and not the actually items selected. They are all tied to Defined Name lists.

Example:
1st ListBox -
Item 1 Af selected
Item 2 ds
Item 3 FG

2nd ListBox -
Item 1 JK
Item 2 KL selected
Item3 GH

Result:

1st LB Item1 (Af)
2nd LB item 1 (JK)
and so on
Help, please

Private Sub ChrisInfo_CB_Click()


    Call Christer1
    Call Christer2
    Call Christer3
    Call Christer4
    Call Christer5


End Sub
Private Sub Christer1()


   Dim I As Long
   Dim J As Long
   Dim arrItems()
    ReDim arrItems(0 To Chris1.ColumnCount - 1)
    For J = 0 To Chris1.ListCount - 1
        If Chris1.Selected(J) Then
            For I = 0 To Chris1.ColumnCount - 1
                arrItems(I) = Chris1.Column(I, J)
            Next I
            With Sheets("Sheet2")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, Chris1.ColumnCount).Value = arrItems
            End With
        End If
    Next J


End Sub
Private Sub Christer2()


   Dim S As Long
   Dim D As Long
   Dim arrItems()
    ReDim arrItems(0 To Chris1.ColumnCount - 1)
    For D = 0 To Chris2.ListCount - 1
        If Chris1.Selected(D) Then
            For S = 0 To Chris2.ColumnCount - 1
                arrItems(S) = Chris2.Column(S, D)
            Next S
            With Sheets("Sheet2")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, Chris2.ColumnCount).Value = arrItems
            End With
        End If
    Next D


End Sub
Private Sub Christer3()


   Dim V As Long
   Dim B As Long
   Dim arrItems()
    ReDim arrItems(0 To Chris3.ColumnCount - 1)
    For B = 0 To Chris3.ListCount - 1
        If Chris3.Selected(B) Then
            For V = 0 To Chris3.ColumnCount - 1
                arrItems(V) = Chris3.Column(V, B)
            Next V
            With Sheets("Sheet2")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, Chris3.ColumnCount).Value = arrItems
            End With
        End If
    Next B


End Sub
Private Sub Christer4()


   Dim T As Long
   Dim Y As Long
   Dim arrItems()
    ReDim arrItems(0 To Chris4.ColumnCount - 1)
    For Y = 0 To Chris4.ListCount - 1
        If Chris4.Selected(Y) Then
            For T = 0 To Chris4.ColumnCount - 1
                arrItems(T) = Chris4.Column(T, Y)
            Next T
            With Sheets("Sheet2")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, Chris4.ColumnCount).Value = arrItems
            End With
        End If
    Next Y


End Sub
Private Sub Christer5()


   Dim Z As Long
   Dim J As Long
   Dim arrItems()
    ReDim arrItems(0 To Chris5.ColumnCount - 1)
    For X = 0 To Chris5.ListCount - 1
        If Chris5.Selected(X) Then
            For Z = 0 To Chris5.ColumnCount - 1
                arrItems(Z) = Chris5.Column(Z, X)
            Next Z
            With Sheets("Sheet2")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, Chris5.ColumnCount).Value = arrItems
            End With
        End If
    Next X


End Sub

DThib

 

[My Aswer Is This]

If I understand you have a Multiselect UserForm Listbox

And you want to select several items in the listbox and then click a Button and have those selected items entered some place on your sheet.

1. Is this a Multicolumn ListBox?

Where on your sheet do you want these items entered?

I need sheet names and column Letters

Like Sheet name Jane first empty cell in column B

Please do not say read my code.

I will help you with first listbox and you should be able to do the other 4

 

[Fluff]

On Christer2 shouldn't this be 2 not 1

 If Chris[COLOR=#ff0000]1[/COLOR].Selected(D) Then

 

[DThib]

Thanks Fluff!
That solved it.

That's what I get for copying formulas down

DThib

 

[Fluff]

You're welcome & thanks for the feedback