Load ListBox2 from ListBox1

[Fuzzhead]

I have a userform with two list boxes. The first listbox is loaded from a
table with the following line from my macro: ListBox1.List() = myArray. With
myArray as Variant. I also used the following so I can pick more than one
item: ListBox1.MultiSelect = fmMultiSelectMulti.

When I pick from the list in ListBox1 and click on my commandButton2 with
the following code nothing happens. The picked items from ListBox1 are not
added to ListBox2.

Private Sub CommandButton2_Click()
If ListBox1.ListIndex > -1 Then
ListBox2.AddItem ListBox1.Text
ListBox1.ListIndex = -1
End If
End Sub

What am I doing wrong?

 

[Greg Maxey]

Private Sub CommandButton2_Click()
Dim i As Long
'Cylcle through each item in the listindex
For i = 0 To Me.ListBox1.ListCount - 1
'If the item is selected add it to ListBox2
If Me.ListBox1.Selected(i) Then
ListBox2.AddItem ListBox1.List(i)
End If
Next i
'Cycle through each item in the list and clear the selection.
For i = 0 To Me.ListBox1.ListCount - 1
Me.ListBox1.Selected(i) = False
Next i
End Sub

 

[Fuzzhead]

Thanks for the help Greg.

Your macro only loads part of the item picked in listBox1 into ListBox2. It
only loads the first word. The following macro is what I use to load ListBox1:

Private Sub UserForm_Initialize()
Dim myArray() As Variant
Dim sourcedoc As Document
Dim i As Integer
Dim j As Integer
Dim myitem As Range
Dim m As Long
Dim n As Long
Application.ScreenUpdating = False
Set sourcedoc = Documents.Open(FileName:="C:\Test.doc", Visible:=False)
i = sourcedoc.Tables(1).Rows.Count
j = sourcedoc.Tables(1).Columns.Count
ListBox1.ColumnCount = j
'Hide column 2
ListBox1.ColumnWidths = "40;40"
ReDim myArray(i, j)
For n = 0 To j - 1
For m = 0 To i - 1
Set myitem = sourcedoc.Tables(1).Cell(m + 1, n + 1).Range
myitem.End = myitem.End - 1
myArray(m, n) = myitem.Text
Next m
Next n
ListBox1.List() = myArray
ListBox1.MultiSelect = fmMultiSelectMulti
sourcedoc.Close SaveChanges:=wdDoNotSaveChanges
End Sub


I need it to load everything. I hope this makes sense.

 

[Greg Maxey]

I don't know it this is the best way or not, but this might work:

Private Sub CommandButton2_Click()
Dim i As Long
Dim j As Long
Me.ListBox2.Clear
'Cylcle through each item in the listindex
j = 0
For i = 0 To Me.ListBox1.ListCount - 1
'If the item is selected add it to ListBox2
If Me.ListBox1.Selected(i) Then
With ListBox2
.AddItem
.Column(0, j) = ListBox1.Column(0, i)
.Column(1, j) = ListBox1.Column(1, i)
.Column(2, j) = ListBox1.Column(2, i)
End With
j = j + 1
End If
Next i
'Cycle through each item in the list and clear the selection.
For i = 0 To Me.ListBox1.ListCount - 1
Me.ListBox1.Selected(i) = False
Next i
End Sub

 

[Greg Maxey]

Or you might use this:

Dim i As Long
Dim x As Long
Dim y As Long
Dim arrTest() As Variant
Me.ListBox2.Clear
x = -1
'Determine number of elements needed in array
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
x = x + 1
End If
Next i
'Size the array
ReDim arrTest(x, Me.ListBox1.ColumnCount - 1)
'Build the array
x = 0
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
For y = 0 To Me.ListBox1.ColumnCount - 1
arrTest(x, y) = ListBox1.List(i, y)
Next y
x = x + 1
End If
Next i
'Populate the listbox
Me.ListBox2.List = arrTest()

 

[Fuzzhead]

Greg,

That macro still only loaded column 1 from ListBox1 into ListBox2.

 

[Greg Maxey]

Send me e-mail and I will send you a working example.

 

[Greg Maxey]

I have assumed that there is a column in ListBox2 for each column in
ListBox1. Is this correct or are you trying to place all of the data in
muliplt columns from ListBox1 into a single column in ListBox2?

 

[Greg Maxey]

If the latter, then change:

.AddItem
.Column(0, j) = ListBox1.Column(0, i)
.Column(1, j) = ListBox1.Column(1, i)
.Column(2, j) = ListBox1.Column(2, i)

to:

.AddItem
.List(j) = ListBox1.List(i, 0) & " " & ListBox1.List(i, 1) & " " &
ListBox1.List(i, 2)

 

[Fuzzhead]

Greg,

Your macro did not load the second column in ListBox2 because I forgot to
change the ColumnCount to two. Once I did that your first macro worked.

With my choices loaded into ListBox2, I try to load the info in ListBox2
into a table in my document. I get the following error:

Could not get List property. Invalid property array index.

at this line in my macro:

ActiveDocument.Tables(1).Cell(ii, 1).Range = UserForm1.ListBox2.List(i, 0).

If I end the debuger, my info from ListBox2 is in my table, but there are 2
blank rows at the end of the table and my curser is in the first column of
the first empty row.

I got this macro from searcing this site and it looked like it was what I
needed.

Here is the macro:

rownum = ActiveDocument.Tables(1).Rows.Count + 3
i = 0
ii = 3
Do Until ii > rownum
ActiveDocument.Tables(1).Rows.Add
ActiveDocument.Tables(1).Cell(ii, 1).Select
ActiveDocument.Tables(1).Cell(ii, 1).Range = UserForm1.ListBox2.List(i, 0)
ActiveDocument.Tables(1).Cell(ii, 2).Select
ActiveDocument.Tables(1).Cell(ii, 2).Range = UserForm1.ListBox2.List(i, 1)
ii = ii + 1
i = i + 1
Loop

 

[Greg Maxey]

Seems like this would work:

Private Sub CommandButton4_Click()
Dim myArray() As Variant
Dim oTbl As Word.Table
Dim i As Long
Dim j As Long
myArray() = Me.ListBox2.List
Set oTbl = ActiveDocument.Tables.Add(Selection.Range, _
Me.ListBox2.ListCount, Me.ListBox2.ColumnCount)
For i = 0 To oTbl.Columns.Count - 1
For j = 0 To oTbl.Rows.Count - 1
oTbl.Cell(j + 1, i + 1).Range.Text = myArray(j, i)
Next j
Next i
End Sub

It is a little difficult to write code for your specific situation without
having access to your documents and forms. Again, if you will send me an
e-mail I will send you back the example files that I have been using. With
those, you should be able to make yours work.

 

[Fuzzhead]

Greg,

I almost got it to work the way I want it. I fixed the error problem. How do
I delete the last two rows in the table? They are both blank. If I can do
this my macro will work.

 

[Greg Maxey]

Well this is crude, but if you don't want to clean up your existing code so
the extra rows aren't created in the the first place then add the following:

ActiveDocument.Tables(1).Rows.Last.Delete
ActiveDocument.Tables(1).Rows.Last.Delete

 

[Fuzzhead]

Greg,

That worked. Thank you for all your help.
I thought this way was easer than cleaning up my existing code.