I am using the macro below to merge all selected cells vertically to the top selected cell(s). I am looking to delete the entire rows of the cells below the top selected cell after they have been merged. Any ideas on how to accomplish this? Thanks.
Option Explicit
Sub JoinMerge()
'Merge selected cells into the top-most cell
Dim Cell As Range, resp
Dim outputText As String, r As Long, c As Long
Dim x As Long, y As Long, i As Long, j As Long
On Error Resume Next
x = Selection.Rows(1).Row: i = Selection.Columns(1).Column
y = Selection.Rows.Count + x - 1: j = Selection.Columns.Count + i - 1
On Error Resume Next
If Selection.Count < 2 Then Exit Sub
For c = i To j
For r = x To y
'combine cells and add in space in between them
outputText = outputText & Cells(r, c).Value & " "
Next r
With Range(Cells(x, c), Cells(y, c))
.Clear
Cells(x, c).Value = outputText
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
End With
outputText = "": Next c
End Sub
Bookmarks