Row merge in table RRS feed

  • Question

  • Hello,

    The below macro by Paul Edstein working fine per the requirement till now, I need this macro to meet few more conditions.

    1. It should not merge the rows when the column next to it has values in the next continous rows.

    I have highlighted rows with green which can be merged and highlighted with orange which should not be  merged in the tables

    Below link for reference.

    2. Currently it works for all the tables in the document, but it should work only for the table I select.

    Sub TableCleaner()
    Application.ScreenUpdating = False
    Dim Tbl As Table, r As Long, Rng1 As Range, Rng2 As Range, Rng3 As Range
    For Each Tbl In ActiveDocument.Tables
      With Tbl
        For r = .Rows.Count To 2 Step -1
          Set Rng1 = .Cell(r, 1).Range
          If Len(Rng1.Text) > 2 Then
            If Rng1.Font.Bold = False Then
              Set Rng2 = .Cell(r - 1, 1).Range
              If Rng2.Font.Bold = False Then
                Set Rng3 = .Rows(r - 1).Range
                If Len(Rng3.Text) > 2 * Rng3.Cells.Count + 2 Then
                  Rng3.Start = Rng2.End
                  If Len(Rng3.Text) = 2 * Rng3.Cells.Count + 2 Then
                    Rng1.InsertBefore Rng2.Text
                    .Rows(r - 1).Delete
                  End If
                End If
              End If
            End If
          End If
      End With
    Application.ScreenUpdating = True
    End Sub

    Note: The current macro merges with both the highlighted rows

    Any help



    Sunday, December 29, 2019 3:34 AM