Fill Array from every 2nd Column in Word Table

[AndreaM]

Hi, I am trying to fill an array from a Word Table but only use values from every second column but starting from column 1 then skip the second column and add value from 3rd column and so on.


Public Function FillArray()
Dim myArray() As String
Dim i As Long
Dim j As Long
Dim pRow As Long
Dim oTbl As Word.Table
Set oTbl = ActiveDocument.Tables(3)
ReDim myArray(oTbl.Rows.Count - 3, oTbl.Columns.Count - 1)
For i = 0 To UBound(myArray, 1)
For j = 0 To UBound(myArray, 2)
myArray(i, j) = Left(oTbl.Cell(i + 2, j + 1), Len(oTbl.Cell(i + 2, j + 1).Range.Text) - 2)
Next
Next
FillArray = myArray
End Function

[AndreaM]

Hi, so this is my code which now pulls the info only from the every second column but when it populates the Listbox then it also skips every second column. Can someone please assist as I am battling to figure it out.



Sub Cloud()
Dim oFrm As Cloud
Set oFrm = New Cloud
If ActiveDocument.Tables(3).Rows.Count > 2 And Not ActiveDocument.Tables(3).Rows(2).Cells(1).Range.Text = Chr(13) & Chr(7) Then
With oFrm.ListBox1
.List = FillArray
.ColumnCount = 5
End With
End If


oFrm.Show
Unload oFrm
Set oFrm = Nothing


lbl_Exit:


Exit Sub
End Sub



Public Function FillArray()Dim myArray() As String
Dim i As Long
Dim j As Long
Dim pRow As Long
Dim pColumns As Long


Dim oTbl As Word.Table
Set oTbl = ActiveDocument.Tables(3)
ReDim myArray(oTbl.Rows.Count - 3, oTbl.Columns.Count - 2)

For i = 0 To UBound(myArray, 1)
For j = 0 To UBound(myArray, 2)
myArray(i, j) = Left(oTbl.Cell(i + 2, j + 1), Len(oTbl.Cell(i + 2, j + 1).Range.Text) - 2)
j = j + 1
'MsgBox j
Next
Next
FillArray = myArray
End Function

[AndreaM]

Please could someone help as I still can't figure out what is wrong. If I show the values of the Array in a MsgBos it returns the correct values and number of values, but when it populates the ListBox in the user form, it only populates every second column. I would like to create an array from every second column from a word table to populate each column in a ListBox.

[gmaxey]

Sub Cloud()
Dim oFrm As Cloud
Dim oTbl As Table
Set oFrm = New Cloud
Set oTbl = ActiveDocument.Tables(1)
If oTbl.Rows.Count > 2 And Not oTbl.Rows(2).Cells(1).Range.Text = Chr(13) & Chr(7) Then
With oFrm.ListBox1
.List = FillArray(oTbl)
.ColumnCount = 5
End With
End If
oFrm.Show
Unload oFrm
Set oFrm = Nothing
lbl_Exit:
Exit Sub
End Sub
Public Function FillArray(oTbl As Table)
Dim myArray() As String
Dim i As Long
Dim j As Long
Dim pRow As Long
Dim pColumns As Long
Set oTbl = ActiveDocument.Tables(1)
ReDim myArray(oTbl.Rows.Count - 3, oTbl.Columns.Count - 2)
For i = 0 To UBound(myArray, 1)
For j = 0 To UBound(myArray, 2) Step 2
myArray(i, j) = Left(oTbl.Cell(i + 2, j + 1), Len(oTbl.Cell(i + 2, j + 1).Range.Text) - 2)
Next
Next
FillArray = myArray
End Function

[AndreaM]

Many thanks Greg, but I am still getting the exact same results. See images

Word table
19497

Userform
19498

[gmaxey]

I see. Try this:


Sub Cloud()
Dim oFrm As Cloud, oTbl As Table
Set oFrm = New Cloud
Set oTbl = ActiveDocument.Tables(1)
If oTbl.Rows.Count > 2 And Not oTbl.Rows(2).Cells(1).Range.Text = Chr(13) & Chr(7) Then
With oFrm.ListBox1
.List = FillArray(oTbl)
.ColumnCount = 5
End With
End If
oFrm.Show
Unload oFrm
Set oFrm = Nothing
lbl_Exit:
Exit Sub
End Sub
Public Function FillArray(oTbl As Table)
Dim myArray() As String
Dim i As Long, j As Long, lngCount As Long
Set oTbl = ActiveDocument.Tables(1)
ReDim Preserve myArray(oTbl.Rows.Count - 3, lngCount)
For i = 0 To UBound(myArray, 1)
lngCount = 0
For j = 1 To oTbl.Columns.Count Step 2
If i = 0 Then
ReDim Preserve myArray(oTbl.Rows.Count - 3, lngCount)
End If
lngCount = lngCount + 1
myArray(i, lngCount - 1) = Left(oTbl.Cell(i + 2, j), Len(oTbl.Cell(i + 2, j).Range.Text) - 2)
Next
Next
FillArray = myArray
End Function

[AndreaM]

Thank you so much. As always you are an absolute star.