Merging Cells row by row without losing any data - vba

Question

I'm getting data that is in 1, 2, or 3 columns (possibly more). I need each row to combine the data in the respective row without losing any of the data from any columns.
I managed to get some code together that will combine the cells properly, but I'm struggling to use this code to look through each row and combine the cells in that row, for all rows that contain data.
Here is what I have so far:
Sub JoinAndMerge()
'joins all the content in selected cells
'and puts the resulting text in top most cell
'then merges all cells
Dim outputText As String
Const delim = " "
On Error Resume Next
For Each cell In Selection
outputText = outputText & cell.value & delim
Next cell
With Selection
.Clear
.Cells(1).value = outputText
.Merge
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
End With
End Sub
And here's what I've got as far as trying to get it to look through each row.
Sub JoinAndMerge2()
'joins all the content in selected cells
'and puts the resulting text in top most cell
'then merges all cells
Dim outputText As String
Const delim = " "
On Error Resume Next
Dim cell_value As Variant
Dim counter As Integer
Dim xlastRow As Long
Dim xlastColumn As Long
xlastRow = Worksheets("Sheet48").UsedRange.Rows.Count
xlastColumn = Worksheets("Sheet48").UsedRange.Columns.Count
'Looping through A column define max value
For i = 1 To xlastRow
'Row counter
counter = 1
'Take cell one at the time
cell_value = ThisWorkbook.ActiveSheet.Cells(1, i).value
For Each cell In Selection
outputText = outputText & cell.value & delim
Next cell
With Selection
.Clear
.Cells(1).value = outputText
.Merge
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
End With
counter = counter + 1
Next i
End Sub
How do I get this to loop properly through each row?
If it helps, before on left, after on right:

Answer 1

I never recommend merging cells, but if you must...
This is dynamic by row (determined by Column A) and column. Each merge size is dependent on each rows furthest right non-blank column. Therefore, some merged cells will span 2 columns and some will span 3. If you don’t want that to be the case, you will need to find the max used column and merge by that column index
I.E. replacing MyCell.Resize(1, i -1).Merge with MyCell.Resize(1, MaxCol).Merge where MaxCol is your max used column.
Option Explicit
Sub Merger()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim MyCell As Range, Merged As String, i, iArr
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each MyCell In ws.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
For i = 1 To ws.Cells(MyCell.Row, ws.Columns.Count).End(xlToLeft).Column
Merged = Merged & Chr(32) & MyCell.Offset(, i - 1) 'Build String
Next i
MyCell.Resize(1, i - 1).Merge 'Merge
MyCell = Right(Merged, Len(Merged) - 1) 'Insert String
Merged = "" 'Reset string for next loop
MyCell.HorizontalAlignment = xlGeneral
MyCell.VerticalAlignment = xlCenter
MyCell.WrapText = True
Next MyCell
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 2

It can't be stressed too much. Merged cells should be avoided.
They play havoc when dragging an area to populate cells. They interrupt the double click autofill and make copying and pasting an exercise in frustration. They delay development and add complexity to formulas and VBA code all the while creating more opportunities for an error to occur or a bug to go unnoticed.
So i urge you to reconsider using merged cells.
Almost to prove the point, you'll find "*****" on a few lines in the two solutions below. Each one of those lines needs to be handled uniquely. Care to guess why? The merged cell you currently have in row 1. That merged cell can cause those lines to either halt with an error or continue with the possibility of unwanted consequences depending on which cell addresses actually hold row 1 data.
Merged cells are absolutely horrid and considered among the greatest of Excel sins.
Here are two ways forward without merged cells...
In VBA (psuedo code)
For (Columns, 2, LastColumn, Step 2)
For(Rows, 3, LastRow)
With Worksheet
If .Cells(Row,Column) <> vbNullString then
.cells(Row,Column-1)=.cells(Row,Column-1).Value2 _
& StringDeliminator & .cells(Row,Column).Value2
End If
End with
Next Rows
Columns (Column).EntireColumn.Delete*****
Next Columns
Using formulas in a worksheet
Add a new column C
In cell C3 use the formula
=If(A3<>"",C3=A3 & " " & B3,"")
Drag the formula down(copy to other columns if needed)
Ctrl Shift Up to select all the formulas
Copy *****
Paste Special Values *****
Delete columns A and B *****
There is one situation where merged cells are ok...
if you're in a situation where you're against the wall, there is nothing you can do because your manager doesn't care if your work is incompatible with his analyst's automation tools and refuses to accept center across selection as a viable alternative because "i know what center does and it does not help, you have to merge cells to get the text centered over those columns ".... if this is your situation then merged cells are ok, just use this method:: first, start looking for another job (or a promotion above your manager, your company should already be looking) and second, submit the broken merged cell version to the snowflake and quitely slip the functional version to your analyst as a preliminary estimate
That's the only time I authorize you to use merged cells.