View Single Post
 
Old 09-13-2022, 06:30 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,176
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

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
The intention is that any time the inputs don't match, the table or rows will be highlighted.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote