Multiple Selection ListBox to Single FormField

[flohrstw]

I have a ListBox (ListBoxA) in a UserForm that is initiated upon opening a word template.

ListBoxA is populated from SourceDoc.docx which contains a table with the associated data.

ListBoxA is populated correctly from SourceDoc, and on CmdSubmit, it properly fills FormFieldA if ListBoxA is setup for a single selection.

When I change the ListBoxA properties for multiple selections I receive the following error: "Run Time Error '381.' Could not get the column property. Invalid property array index."

I am attempting to display anywhere between one and multiple selections in FormFieldA based upon the selection(s) in ListBoxA.

Here is the code:
Private Sub cmdSubmit_Click()
With ActiveDocument
.FormFields("ResultA").Result = ListBoxA.Column(1)
End With
Application.ScreenUpdating = True
Unload Me
Exit Sub

Dim i As Integer
Dim Client As String
Dim oRng As Word.Range
Client = ""
For i = 1 To ListBoxA.ColumnCount
ListBoxA.BoundColumn = i
Select Case True
Case i = ListBoxA.ColumnCount - 1
Client = Client & ListBoxA.Value & " "
Case i = ListBoxA.ColumnCount
Client = Client & ListBoxA.Value & vbCr
Case Else
Client = Client & ListBoxA.Value & vbCr & vbTab
End Select
Next i
Set oRng = ActiveDocument.Bookmarks("Client").Range
oRng.Text = Client
ActiveDocument.Bookmarks.Add "Client", oRng
Me.Hide
lbl_Exit:
Exit Sub
End Sub

and

Private Sub UserForm_Initialize()
Dim arrData() As String
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:="SourceDoc.docx", Visible:=False)
i = sourcedoc.Tables(1).Rows.Count - 1
j = sourcedoc.Tables(1).Columns.Count
ListBoxA.ColumnCount = j
ReDim arrData(i - 1, j - 1)
For n = 0 To j - 1
For m = 0 To i - 1
Set myitem = sourcedoc.Tables(1).Cell(m + 2, n + 1).Range
myitem.End = myitem.End - 1
arrData(m, n) = myitem.Text
Next m
Next n
ListBoxA.List = arrData
ListBoxA.ColumnWidths = "50; 0"
sourcedoc.Close SaveChanges:=wdDoNotSaveChanges
lbl_Exit:
Exit Sub
End Sub

Any recommendations or assistance would be greatly appreciated. Thanks.

[Tinbendr]

You will have to iterate with a loop outside the 'For i' loop and test for selection.

P
For J = 0 To Me.ListBoxA.ListCount - 1
If Me.ListBoxA.Selected(J) Then
For i = 1 To ListBoxA.ColumnCount

[flohrstw]

I've included the loop statement as suggested by Tinbendr and believe its in the correct spot. Now I've run into an error with the 'End If' statement. I'm pretty green when it comes to VB and I'm not exactly sure how to wrap this up. Here's what I have now:

Dim arrData() As String
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:="F:\SourceLanguage.docx", Visible:=False)
i = sourcedoc.Tables(1).Rows.Count - 1
j = sourcedoc.Tables(1).Columns.Count
ListBoxA.ColumnCount = j
For j = 0 To Me.ListBoxA.ListCount - 1
If Me.ListBoxA.Selected(j) Then
For i = 1 To ListBoxA.ColumnCount
ReDim arrData(i - 1, j - 1)
For n = 0 To j - 1
For m = 0 To i - 1
Set myitem = sourcedoc.Tables(1).Cell(m + 2, n + 1).Range
myitem.End = myitem.End - 1
arrData(m, n) = myitem.Text
Next m
Next n
Next i
End If
Next j
ListBoxA.List = arrData
ListBoxA.ColumnWidths = "50; 0"
sourcedoc.Close SaveChanges:=wdDoNotSaveChanges
lbl_Exit:
Exit Sub
End Sub

Thanks for all of your help.

[gmaxey]

Populate your listbox:
Private Sub UserForm_Initialize()
Dim arrData() As String
Dim oTbl As Word.Table
Dim i As Integer
Dim J As Integer
Dim myitem As Range
Application.ScreenUpdating = False
Set oTbl = ActiveDocument.Tables(1)
ReDim arrData(oTbl.Rows.Count - 1, oTbl.Columns.Count - 1)
ListBoxA.ColumnCount = oTbl.Columns.Count - 1
For i = 0 To oTbl.Rows.Count - 1
For J = 0 To oTbl.Columns.Count - 1
Set myitem = oTbl.Cell(i + 1, J + 1).Range
myitem.End = myitem.End - 1
arrData(i, J) = myitem.Text
Next J
Next i
ListBoxA.List = arrData
ListBoxA.ColumnWidths = "50;0;0"
ListBoxA.MultiSelect = fmMultiSelectMulti
Set oTbl = Nothing
lbl_Exit:
Exit Sub
End Sub


Then iterate the selected items:
Private Sub CommandButton1_Click()
Dim lngIndex As Long
Dim strResult As String
For lngIndex = 0 To Me.ListBoxA.ListCount - 1
If Me.ListBoxA.Selected(lngIndex) Then
strResult = strResult & Me.ListBoxA.List(lngIndex, 0)
End If
Next
MsgBox strResult
End Sub