Moving and storing values between two listboxes and excel sheet

[msmith]

Hello-
I have a named range(E68:F111 with a header on the columns) from an excel worksheet and it populates listbox1. I would like to have a command button that moves an item from listbox1 to listbox2 after that item has been selected. It is not necessary to remove the item that has been transfered from listbox1. I would also like to have a commandbutton to remove an item from listbox2 if it was accidentally moved there.

Then I would like it to take the values from listbox2 and put the info from column one into a new sheet in the range (E12:E34). I would like the corresponding value from column 2, listbox2 put in the same sheet but in the range (K12:K34).

I am able to populate listbox one but am having troubles moving the values for both columns to listbox2 and returning the final values to the new sheet range. I don't know if this is even possible but would appreciate any help.

Thanks in advance,
Mark

[Jacob Hilderbrand]

This demonstrates how to add and remove items from a List Box.

Option Explicit
 
 Private Sub CommandButton1_Click()  'Add Item
Dim i               As Long
 Dim Duplicate       As Boolean
If Me.ListBox1.Text <> "" Then
         For i = 1 To Me.ListBox2.ListCount
             If Me.ListBox2.List(i - 1) = Me.ListBox1.Text Then
                 'Duplicate Entry
                 Duplicate = True
                 Exit For
             End If
         Next i
         If Duplicate = False Then
             Me.ListBox2.AddItem Me.ListBox1.Text
         End If
     End If
End Sub
 
 Private Sub CommandButton2_Click()  'Remove Item
If Me.ListBox2.Text <> "" Then
         Me.ListBox2.RemoveItem Me.ListBox2.ListIndex
     End If
End Sub

[Jacob Hilderbrand]

Check out the KB Entry Here. It shows how to let users drag and drop items from one List Box to another.

[msmith]

Hey Jake-

Thanks for the first bit of code. The duplicate check is an interesting idea I had not considered before. Do you have any ideas on how to get the items from listbox2 back into excel? Also when you move the item from box1 to box2 it doesn't display the second column in listbox2. Is it just hidden or does it not move that data over?

Thanks,

Mark

[Jacob Hilderbrand]

For a multi-column List Box try something like this.

Option Explicit
 
Private Sub CommandButton1_Click() 'Add Item
Dim i               As Long
    Dim Duplicate       As Boolean
If Me.ListBox1.Text <> "" Then
        For i = 1 To Me.ListBox2.ListCount
            If Me.ListBox2.List(i - 1) = Me.ListBox1.Column(0, _
                Me.ListBox1.ListIndex) & vbTab & _
                Me.ListBox1.Column(1, Me.ListBox1.ListIndex) Then
                 'Duplicate Entry
                Duplicate = True
                Exit For
            End If
        Next i
        If Duplicate = False Then
            Me.ListBox2.AddItem Me.ListBox1.Column(0, _
            Me.ListBox1.ListIndex) & vbTab & _
            Me.ListBox1.Column(1, Me.ListBox1.ListIndex)
        End If
    End If
End Sub
 
Private Sub CommandButton2_Click() 'Remove Item
If Me.ListBox2.Text <> "" Then
Me.ListBox2.RemoveItem Me.ListBox2.ListIndex
End If
End Sub

Try this code for putting the values into the worksheet.

Private Sub CommandButton3_Click() 'Submit
Dim i           As Long
    Dim n           As Long
    Dim Part1       As String
    Dim Part2       As String
For i = 1 To Me.ListBox2.ListCount
        n = InStr(1, Me.ListBox2.List(i - 1), vbTab)
        Part1 = Left(Me.ListBox2.List(i - 1), n - 1)
        Part2 = Mid(Me.ListBox2.List(i - 1), n + 1, _
        Len(Me.ListBox2.List(i - 1)))
        Sheets("Sheet1").Range("E" & 11 + i).Value = Part1
        Sheets("Sheet1").Range("K" & 11 + i).Value = Part2
    Next i
End Sub

[msmith]

Thanks so much for the prompt reply Jake. The code works great! I attached a mocked down version of my project. I wondered if it was possible to sort the items in listbox1 (userform1) so that it would eliminate all the samples that are blank in the first column. That way you wouldn't have to scroll all the way down to get to the bottom two samples, which are constant.

Thanks,
Mark

[Jacob Hilderbrand]

We can just not put the zero value rows into the List Box. Change the Named Range "SampleRange1" to refer only to E68:E111. Leave off Column F.

Private Sub UserForm_Initialize()
Dim Cel             As Range
Dim NewRange        As Range
For Each Cel In Range("SampleRange1")
        If Cel.Value <> 0 Then
            If NewRange Is Nothing Then
                Set NewRange = Cel
            Else
                Set NewRange = Union(NewRange, Cel)
            End If
        End If
    Next
    Set NewRange = Range(NewRange, NewRange.Offset(0, 1))
    Me.ListBox1.RowSource = NewRange.Address
End Sub

[msmith]

Hey Jake-
The new code seems to return a blank listbox1. Also by eliminating column F in the named range, will that prevent it from being loaded and then later inserted into sheet2?

Thanks,
Mark

[msmith]

Would it be easier to input the named range into the array,if the value is zero then delete that complete row of the array and finally store the array into the listbox?

[Jacob Hilderbrand]

Try this.

Option Explicit
  
 Private Sub UserForm_Initialize()
Dim MyArray()   As String
     Dim i           As Long
ReDim MyArray(67 To 109, 1 To 2)
     For i = 67 To 109
         If Range("E" & i).Text <> "" Then
             MyArray(i, 1) = Range("E" & i).Text
             MyArray(i, 2) = Range("F" & i).Text
         End If
     Next
Me.ListBox1.List = MyArray
End Sub

[surya prakash]

Hello Jake,

Getting runtime error '70' permission denied error on running the above code.

Option Explicit 
 
Private Sub UserForm_Initialize() 
Dim MyArray() As String 
Dim i As Long 
ReDim MyArray(67 To 109, 1 To 2) 
For i = 67 To 109 
If Range("E" & i).Text <> "" Then 
MyArray(i, 1) = Range("E" & i).Text 
MyArray(i, 2) = Range("F" & i).Text 
End If 
Next 
Me.ListBox1.List = MyArray 
End Sub

[Jacob Hilderbrand]

Try this attachment.

[msmith]

Hey Jake thanks again. The new code works great.....with one exception. But I was able to fix it! I had become a little frustrated and moved the last two samples (pos control and neg control) to the top of the list so that it wouldn't have to sort all the way through the list. But my code wouldn't account for an empty row. Your code does! I altered yours to have a different temp variable to load the array so that it won't increment if the search value is null. This prevents an empty row being loaded into the array when the search functions as it should.

Private Sub UserForm_Initialize()
Dim MyArray() As String
    Dim i As Long
    Dim k As Long
ReDim MyArray(67 To 111, 1 To 2)
Windows("Book2.xls").Activate
    Sheets("Sheet1").Select
    k = 67
    For i = 67 To 111
        If Range("E" & i).Text <> "" Then
            MyArray(k, 1) = Range("E" & i).Text
            MyArray(k, 2) = Range("F" & i).Text
            k = k + 1
        End If
    Next
Me.ListBox1.List = MyArray
End Sub

One more question. I have tried to load the first value of the array as the header columns in the listbox and have been unsuccessful. From what I have read I think this can only be done with a 'range' of data. Is this true or is there a secret that I can't find in my long two weeks of learning vba!?

Again thanks for all your help. I have changed other areas of my project (not posted here) to improve the code dramatically.

Mark

[Jacob Hilderbrand]

You can load the data into a worksheet, then set the RowSourse property to that range of data.

[msmith]

Easy enough! I can handle that. Thanks again!

[Jacob Hilderbrand]

You're Welcome

Take Care