none
Row merge in tables -Ms Word RRS feed

  • Question


  • Hello all,

    I have many blank cells in the 2nd 3rd and 4th columns in a table in the below link. All I want to remove the blank cells and merge and make it into one single row.

    Example 1: The first 3 separate rows start with : Northrop Grumman Corp., Sr.:  in the table (refer the below link) should be merged into one single row and the numeric values in the next columns should remains in  the same columns/cell..

    Example 2: The 4 separate rows (starting 4th row in the table) start with “Rockwell Collins, …in the table (refer the below link)  should be merged into one single rows and the numeric values should remains on the same columns/cell.

    Likewise all the rows with the same format in the entire document, is there any way to do it... 

    https://www.dropbox.com/home?preview=Row+merge.docx

    Posted the file in the below link


    Saturday, March 9, 2019 5:53 PM

All replies

  • Your link is invalid, so it's impossible to know what you're working with.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Monday, March 11, 2019 4:50 AM
  • Hi Paul, 

    Thanks for checking and could you please try the below link

    https://www.dropbox.com/s/4jjcywrgahw9ipw/Row%20merge.docx?dl=0

    Also, the bold text rows should not merge with others and it can remain as is.

    Thanks

    James


    Monday, March 11, 2019 2:01 PM
  • Try the following macro:

    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
        Next
      End With
    Next
    Application.ScreenUpdating = True
    End Sub

    For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm
    For Mac macro installation & usage instructions, see: https://wordmvp.com/Mac/InstallMacro.html


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Proposed as answer by macropodMVP Wednesday, March 13, 2019 9:11 PM
    Monday, March 11, 2019 9:24 PM
  • Awesome its working!!!

    Thanks Paul

    Wednesday, March 13, 2019 2:10 AM
  • Hi Paul,

    Greetings to you!!!

    The provided macro working fine till now. I need this macro to meet few more requirements.

    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 rows with orange which should not be  merged in the tables

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

    Below link for reference.

    https://gofile.io/?c=qLYJK3

    Thanks 

    James

    Thursday, January 16, 2020 5:15 AM