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
Capture1.jpg

Userform
Capture.PNG

[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.