CODEWITHSUNDEEP
vbaexcelexcel-formula
Valborg
Valborg

Reputation: 79

Merging Cells row by row without losing any data

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:

1 2

Upvotes: 0

Views: 1034

Answers (2)

ProfoundlyOblivious
ProfoundlyOblivious

Reputation: 1485

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.

Upvotes: 0

urdearboy
urdearboy

Reputation: 14580

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

Upvotes: 1

Related Questions