Transferring data from a multi column listbox to a single cell in a worksheet

[stirlingmw]

So i have been trying to get a Userform which transfers a selection from 2 listboxes into a single multicolumn listbox to work. With the help of this forum i have also been able to pass that data over to another "Master" Userform. What i am now struggling to do is 2 things.

1. When the command button on the "Master" Userform "Save" is pressed the data from Listbox1 should be passed across to worksheet "Master" column "C". I have managed to do this of sorts, but only the first column of data out of 2 is transferred to the relevant cell. How do I pass both columns to the same Cell.

2. My 2nd Userform enables me to generate the data in listbox1 by passing selected data from 2 listboxes "listRole" and "listName" into a third "listResponsible" as a single line of data at a time and removing the selected data from listRole and listName so the same data cannot be selected more than once. This Userform is opened from a command button on my "Master" Userform above listbox1. If data is already present in listbox1 i would like this data to appear in listResponsible and the relevant data from Role and Name to be removed from listRole and listName.

Code i am using is

'Move selected data into a single listbox
Private Sub BTN_MoveSelectedRight_Click()
Dim lb1 As MSForms.ListBox
Dim lb2 As MSForms.ListBox
Dim lb3 As MSForms.ListBox


    Set lb1 = Me.ListRole
    Set lb2 = Me.ListName
    Set lb3 = Me.ListBox2


    If lb1.ListIndex >= 0 And lb2.ListIndex >= 0 Then
        lb3.AddItem lb1.Value
        lb3.List(lb3.ListCount - 1, 1) = lb2.Value


'       lb1.RemoveItem lb1.ListIndex
        lb2.RemoveItem lb2.ListIndex
       lb1.ListIndex = -1
       lb2.ListIndex = -1
    End If


End Sub

and the code to pass the multicolumn data from listbox2 to listbox1 on "Master" Userform

Private Sub CmdSave_Click()
For i = 0 To Me.ListBox2.ListCount - 1
        filled = False
        For j = 0 To Listbox1.ListBox2.ColumnCount - 1
            If Listbox1.ListBox2.List(i, j) <> "" Then
                filled = True
                Exit For
            End If
        Next
        If filled Then
            Master.Listbox1.AddItem ListBox2.List(i, 0)
            Master.Listbox1.List(Master.Listbox1.ListCount - 1, 0) = Me.ListBox2.List(i, 0)
            Master.Listbox1.List(Master.Listbox1.ListCount - 1, 1) = Me.ListBox2.List(i, 1)
        End If
    Next
Unload Me
End Sub

Thanks
Steve

 

[DanteAmor]

and the code to pass the multicolumn data from listbox2 to listbox1 on "Master" Userform

Private Sub CmdSave_Click()
For i = 0 To Me.ListBox2.ListCount - 1
        filled = False
        For j = 0 To [COLOR=#ff0000]Listbox1[/COLOR].ListBox2.ColumnCount - 1 [COLOR=#ff0000]'must be Me[/COLOR]
            If [COLOR=#ff0000]Listbox1[/COLOR].ListBox2.List(i, j) <> "" Then   [COLOR=#FF0000]'must be Me[/COLOR]
                filled = True
                Exit For
            End If
        Next
        If filled Then
            Master.Listbox1.AddItem ListBox2.List(i, 0)
            [COLOR=#ff0000]Master.Listbox1.List(Master.Listbox1.ListCount - 1, 0) = Me.ListBox2.List(i, 0)[/COLOR]  [COLOR=#FF0000]'[/COLOR][COLOR=#ff0000]It's not necesary[/COLOR]
            Master.Listbox1.List(Master.Listbox1.ListCount - 1, 1) = Me.ListBox2.List(i, 1)   
        End If
    Next
Unload Me
End Sub

-----

1. When the command button on the "Master" Userform "Save" is pressed the data from Listbox1 should be passed across to worksheet "Master" column "C". I have managed to do this of sorts, but only the first column of data out of 2 is transferred to the relevant cell. How do I pass both columns to the same Cell.

Try this:

Private Sub CmdSave_Click()
    Dim i As Long, j As Long, filled As Boolean, lr As Long, sh As Worksheet
    For i = 0 To Me.Listbox2.ListCount - 1
        filled = False
        For j = 0 To Me.Listbox2.ColumnCount - 1
            If Me.Listbox2.List(i, j) <> "" Then
                filled = True
                Exit For
            End If
        Next
        If filled Then
            Master.Listbox1.AddItem Listbox2.List(i, 0)
            Master.Listbox1.List(Master.Listbox1.ListCount - 1, 1) = Listbox2.List(i, 1)
        End If
    Next
    
    '[B]Pass to master sheet column C[/B]
    Set sh = Sheets("Master")
    lr = sh.Range("C" & Rows.Count).End(xlUp).Row
    For i = 0 To Master.Listbox1.ListCount - 1
        sh.Range("C" & lr).Value = Master.Listbox1.List(i, 0) & " " & Master.Listbox1.List(i, 1)
        lr = lr + 1
    Next
End Sub

 

[stirlingmw]

Dante Amor
I have had to look at this problem from a different angle as transferring the data in listbox2 to the worksheet didn't quite work, as I may be trying to update a row of data already present. I have altered my code so that data is passed from one Multi Column Listbox on Userfrom1 across to lstTeamLead on another Userform Userform2 and closes Userform1. It is from lstTeamLead that the Multi Column data is then now passed to the worksheet to either update data already there, or add new data to a new line.

The code i am using to do this is:

Private Sub cmdSave_Click()
If TxtProject.text = "" Then
MsgBox "Enter a Project", vbCritical, "Save"
TxtProject.SetFocus
Exit Sub
End If
Call pSave
End Sub

Private Sub pSave()
Dim a As Long




If blnNew = True Then
totRows = Worksheets("Project Master").Range("A1").CurrentRegion.Rows.count
With Worksheets("Project Master").Range("A1")
.Offset(totRows, 0) = TxtProject.text
.Offset(totRows, 1) = CmbTeam.text
.Offset(totRows, 2) = CmbCDTLead.text
.Offset(totRows, 3) = LstTeamLead.text 'This row is the problem

'Many more rows offsetting by 1 column

End With
Call comboboxFill
Else
totRows = Worksheets("Project Master").Range("A1").CurrentRegion.Rows.count
For i = 2 To totRows
    If Trim(Worksheets("Project Master").Cells(i, 1)) = Trim(CmbFindProject.text) Then
Worksheets("Project Master").Cells(i, 1) = TxtProject.text
Worksheets("Project Master").Cells(i, 2) = CmbTeam.text 
Worksheets("Project Master").Cells(i, 3) = CmbCDTLead.text
'Worksheets("Project Master").Cells(i, 4) = LstTeamLead.text 'This is the problem also
'Many more rows offsetting by 1 column
Exit For
End If
Next i
End If
blnNew = False
End Sub

Private Sub comboboxFill()
CmbFindProject.Clear
totRows = Worksheets("Project Master").Range("A1").CurrentRegion.Rows.count
For i = 2 To totRows
CmbFindProject.AddItem Worksheets("Project Master").Cells(i, 1).Value
Next i
End Sub

I hope that explains things a little, as it is starting to confuse me too.

Regards
Steve

 

[DanteAmor]

Dante Amor
I have had to look at this problem from a different angle as transferring the data in listbox2 to the worksheet didn't quite work, as I may be trying to update a row of data already present. I have altered my code so that data is passed from one Multi Column Listbox on Userfrom1 across to lstTeamLead on another Userform Userform2 and closes Userform1. It is from lstTeamLead that the Multi Column data is then now passed to the worksheet to either update data already there, or add new data to a new line.



I hope that explains things a little, as it is starting to confuse me too.

Regards
Steve

If it works for you, it's fine.