Automate Row-wise and Column-wise Merging of Table Cells

macropod · #1 11-15-2024, 03:14 PM

The following macro automates the row-wise merging of cells spanning multiple selected columns & rows in a table. As coded, the macro performs row-wise merging of only the selected cells. Comments in the code show how to adapt it for row-wise merging of all cells to the right of the first selected one and/or to the bottom of the table without having to select all those cells beforehand.

Code:

Sub RowMerge()
Application.ScreenUpdating = False
Dim r As Long, c As Long, x As Long, y As Long
With Selection
  If .Information(wdWithInTable) = True Then
    'For all columns right of the selected cell, delete/comment-out the next line:
    If .Columns.Count < 2 Then GoTo ErrExit
    c = .Cells(1).ColumnIndex
    x = c - 1 + .Columns.Count
    'For all columns right of the selected cell, use:
    'x = .Tables(1).Columns.count
    r = .Cells(1).RowIndex
    y = r - 1 + .Rows.Count
    'For all rows below the selected cell, use:
    'y = .Tables(1).Rows.count
    With .Tables(1)
      For r = r To y
        .Cell(r, c).Merge .Cell(r, x)
      Next
    End With
  Else
ErrExit:
    MsgBox "Please select cells in the columns to process, then try again", vbInformation
  End If
End With
Application.ScreenUpdating = True
End Sub

The following macro automates the column-wise merging of cells spanning multiple selected columns & rows in a table. As coded, the macro performs column-wise merging of only the selected cells. Comments in the code show how to adapt it for column-wise merging of all cells to the right of the first selected one and/or to the bottom of the table without having to select all those cells beforehand.

Code:

Sub ColMerge()
Application.ScreenUpdating = False
Dim r As Long, c As Long, x As Long, y As Long
With Selection
  If .Information(wdWithInTable) = True Then
    'For all rows below the selected cell, delete/comment-out the next line:
    If .Rows.Count < 2 Then GoTo ErrExit
    c = .Cells(1).ColumnIndex
    x = c - 1 + .Columns.Count
    'For all columns right of the selected cell, use:
    'x = .Tables(1).Columns.count
    r = .Cells(1).RowIndex
    y = r - 1 + .Rows.Count
    'For all rows below the selected cell, use:
    'y = .Tables(1).Rows.count
    With .Tables(1)
      For c = c To x
        .Cell(r, c).Merge .Cell(y, c)
      Next
    End With
  Else
ErrExit:
    MsgBox "Please select cells in the rows to process, then try again", vbInformation
  End If
End With
Application.ScreenUpdating = True
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Doing Element wise operation by defined name for two or more data set on the same column in excel?	soroush.kalantari	Excel	2	06-02-2022 10:19 AM
Flip Value Date wise Vertically	suniltko	Excel	2	05-28-2019 12:39 AM
Formula For Sorting In Order Date Wise	suniltko	Excel	5	05-15-2018 09:18 PM
Auto-filter horizontally column wise on basis of date	shoaib1989	Excel	0	02-18-2016 11:16 PM
How to fetch data from one sheet to another with complete details and date wise as well	harisjawed86	Excel Programming	1	08-05-2014 09:10 PM