VBA Word subscripts in Table - vba

Question

I am trying to add text as subscript in a Table Cell in a Word-Document using VBA.
I currently have this code, it is a part of the loop in which I insert my values into the table.
ActiveDocument.Tables(ActiveDocument.Tables.Count).Cell(i, j).Range.Font.Subscript = False
wordArray = Split(ws.Cells(i, j), "_")
For k = LBound(wordArray) To UBound(wordArray)
ActiveDocument.Tables(ActiveDocument.Tables.Count).Cell(i, j).Range.InsertAfter wordArray(k)
ActiveDocument.Tables(ActiveDocument.Tables.Count).Cell(i, j).Range.Font.Subscript = wdToggle
Next k
So I split the text that is in ws.Cells(i,j) on "_"
This can become an array of length 1,2 or 3
Only the second element of the array must be subscript.
My current code should do that, however, it writes the value into the cell based on the last value of Font.Subscript, so either fully normal or fully subscript.
So what I actually want in my table cell is the following
If the ws.Cells has for example a_b_c then b should be subscript and a and c normally written in the table cell. How do I need to change my code to accomplish that?

Answer 1

Since you haven't provided a mvce you'll need to adapt the following example to your needs - . It's main purpose is to demonstrate how to insert text and format it, which is done in the For loop.
Please note how to declare and instantiate a Table object - this is more reliable and more efficient than repeating ActiveDocument.Tables[index].
Use a Range object to write the data to the table cell. Important is "collapsing" the range so that the content is appended, rather than over-written. You need to write a separate range object for each formatting variation.
The code below checks whether the second member of the array is being written. If yes, it's formatted as subscript, if it's another member, then no subscript.
Sub CellContentWithSubscript()
Dim tbl As Word.Table
Dim rng As Word.Range
Dim wordArray '() As Variant
Dim data As String, k As Long
Set tbl = ActiveDocument.Tables(1)
data = "PartOne_Part two_Part three"
wordArray = Split(data, "_")
Set rng = tbl.Cell(1, 1).Range
rng.Collapse 0
rng.MoveEnd wdCharacter, -1
For k = LBound(wordArray) To UBound(wordArray)
rng.Text = wordArray(k)
If k = 1 Then
rng.Font.Subscript = True
Else
rng.Font.Subscript = False
End If
rng.Collapse 0
Next k
End Sub