#1
|
|||
|
|||
How to convert a single row into multiple in MS Word?
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 Last edited by a-friend; 09-14-2022 at 02:38 AM. |
#2
|
||||
|
||||
Forgive my ignorance but ... Is 'Persian' and 'Turkish' being used interchangeably or are they different written languages and both appear in the tables?
You shouldn't iterate through the rows from top to bottom if you are modifying the row count as the loop proceeds. The loop should work from bottom to top. My best guess as to what you are actually requiring is to modify the code this way. If this doesn't work, please post a small sample document that the code is supposed to work on? Code:
Sub fnSplitCellsInNewTableRows() Dim oTable As Word.Table, iPars As Integer, intRow As Integer Dim rngParaLast As Range For Each oTable In ActiveDocument.Tables If oTable.Columns.Count = 2 And oTable.Uniform Then For intRow = oTable.Rows.Count To 1 Step -1 With oTable.Rows(intRow) iPars = .Cells(1).Range.Paragraphs.Count If iPars = .Cells(2).Range.Paragraphs.Count Then If iPars > 1 Then Do While .Cells(1).Range.Paragraphs.Count > 1 .Cells.Split NumRows:=2, NumColumns:=1, MergeBeforeSplit:=False Set rngParaLast = .Cells(1).Range.Paragraphs.Last.Range rngParaLast.MoveEnd Unit:=wdCharacter, Count:=-2 oTable.Rows(intRow + 1).Cells(1).Range.FormattedText = rngParaLast.FormattedText rngParaLast.MoveEnd Unit:=wdCharacter, Count:=1 rngParaLast.MoveStart Unit:=wdCharacter, Count:=-1 rngParaLast.Delete Set rngParaLast = .Cells(2).Range.Paragraphs.Last.Range rngParaLast.MoveEnd Unit:=wdCharacter, Count:=-2 oTable.Rows(intRow + 1).Cells(2).Range.FormattedText = rngParaLast.FormattedText rngParaLast.MoveEnd Unit:=wdCharacter, Count:=1 rngParaLast.MoveStart Unit:=wdCharacter, Count:=-1 rngParaLast.Delete Loop End If Else .Range.HighlightColorIndex = wdYellow End If End With Next intRow Else oTable.Range.HighlightColorIndex = wdBrightGreen 'highlite tables with merged cells or not 2 cols End If Next oTable End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
Quote:
You are more than welcome. Thank you very much for the reply. I edited the thread. I have another Turkish file which has the identical data and I have no idea why they got merged in my mind. So I am sorry for making you confused and thank you for letting me know about it. As for the code you offered, it just changes the contents' predefined white color into yellow and stops working. The problem is that if it works, the code should include an exception too. (I guess I can bring it up here now.) Some sentences either in English and in Persian have some 'notes' under them which should be attached to them. Probably, the code does not consider it and will put the say English note into a separate row and whereas there is no corresponding note for that in the right cell (including the Persian equivalent,) the right cell would be left empty and the code will keep going ahead doing its task. The problem is that when the whole work is done, there would be an extra work on these notes. That said, in a single row, say the right cell might include 10 sentences, but the left cell can have less or more sentence in which the extra sentences are definitely the 'notes' which are preceded by their respective sentence. The same goes with the Persian cells. I was wondering how we can include this exception in the code? |
#4
|
||||
|
||||
I can't do any code modifications without seeing all the variants in actual tables. If the 'notes' are consistently identifiable then the code can be modified to deal with it but it makes it a lot more complicated since we aren't identifying matching pairs by using the paragraph numbers.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#5
|
|||
|
|||
Quote:
Then may I ask you to do me a big favor and build a chatroom and share its URL here so that I could join it and let you know more about it? |
#6
|
||||
|
||||
That isn't going to happen. This forum doesn't have a chatroom or instant messaging function and we are most likely not in similar timezones.
If you want code to work with your actual files then you need to post a sample document. The code I already created works when the paragraph count in the cells matches (as per your initial post's instructions).
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Is there a way to Find multiple text strings in a Word document in a single operation? | wrdy | Word | 8 | 04-03-2022 07:22 PM |
Open Multiple Documents in Single Word 2010 Window? | Clueless in Seattle | Word | 10 | 10-14-2020 08:37 AM |
Search Multiple Strings and if Present get single word as output | transactions | Excel Programming | 1 | 05-17-2019 11:18 AM |
Merging multiple excel records in to a single word doc? | dns_to | Mail Merge | 1 | 10-20-2017 01:22 PM |
Copying Multiple tables from excel into a single word document | dineshtgs | Word Tables | 1 | 04-07-2011 01:27 AM |