Hi there
I have a table with separate rows in which every single row contains lots of English and their Persian equivalents. Each row has lots of Persian sentences on the right cell and each Persian sentence has its own English equivalent written right in front of it on the left cell.
Also, each single row includes two cells:
the right cell contains several Persian sentences and the left cell contains five English equivalents each written right in front of their corresponding Persian sentences.
I need to divide each row into separate rows (to the number of the sentences in the respective row,) to the manner that every single row contains "only one" Persian sentence in the right cell and and its English equivalent in the left cell separately.
I need a macro to avoid inserting separate rows and their contents manually; because:
- the table is too huge. (around 3000 rows)
- it can bring about many mistakes.
Please note that I am using a 64 bit range numbers version of windows 10 and the office 2016 version.
The following VBA macro codes does not work and VBE says the oLeftPar don't exists and I keep receiving the error 5491 in which VBE is not able to find the left cell:
Code:
Option Explicit
Sub fnSplitCellsInNewTableRows()
Dim oTables As Word.Tables 'all document tables
Dim oTable As Word.Table ' each document table
Dim intLenOldLines As LongPtr
Dim intLenNewLines As LongPtr
Dim oLeftPars As Word.Paragraphs 'Paragraphs on the left cell
Dim oRightPars As Word.Paragraphs 'Paragraphs on the right cell
Dim intRow As LongPtr
Dim intTable As LongPtr
Dim intTableRow As LongPtr
Dim intTableRows As LongPtr
Dim intTablesCount As LongPtr
Dim oLeftPar As Word.Paragraph 'unique (left) paragraph to work with
Dim oRightPar As Word.Paragraph 'unique (right) paragraph to work with
Dim oTableRange As Word.Range 'used to Find/Replace ^p
Set oTables = ThisDocument.Tables
intTablesCount = oTables.Count
For intTable = 1 To intTablesCount
Set oTable = oTables(intTable)
If oTable.Columns.Count <> 2 Then
MsgBox "A table with " & oTable.Columns.Count & " columns was discarded."
GoTo lblNextTable
End If
intTableRows = oTable.Rows.Count
For intRow = 1 To intTableRows
intLenOldLines = Len(oTable.Rows(intRow).Cells(1).Range.Text)
intLenNewLines = Len(VBA.Replace(oTable.Rows(intRow).Cells(1).Range.Text, Chr(13), ""))
'compare the amount of chr(13) ocurrences
'each one determine a new inner line on the cell text, except for the last one.
If intLenOldLines > intLenNewLines + 1 Then
Set oLeftPars = oTable.Rows(intRow).Cells(1).Range.Paragraphs
Set oRightPars = oTable.Rows(intRow).Cells(2).Range.Paragraphs
oTable.Rows(intRow).Cells.Split (intLenOldLines - intLenNewLines) + 1, 1
For intTableRow = oTable.Rows.Count To 2 Step -1
Set oLeftPar = oLeftPars(intTableRow - 1)
Set oRightPar = oRightPars(intTableRow - 1)
oTable.Rows(intTableRow).Cells(1).Range.FormattedText = oLeftPar.Range.FormattedText
oTable.Rows(intTableRow).Cells(2).Range.FormattedText = oRightPar.Range.FormattedText
Next
End If
ThisDocument.Save
oTable.Rows(1).Delete ' the original row
'this piece of code strips out ^p on each new cell
oTable.Select
Set oTableRange = oTable.Range
With oTableRange.Find
.ClearFormatting
.Text = "^p"
With .Replacement
.ClearFormatting
.Text = ""
End With
.Execute Replace:=wdReplaceAll, _
Format:=True, MatchCase:=True, _
MatchWholeWord:=True
End With
ThisDocument.Save
Next
lblNextTable:
Next
DoEvents
MsgBox "Done."
End Sub