Merging cells in Excel without loosing data

Question

First of sorry for making a new thread about this but i wasn't able to comment in existing threads.

I'm trying to merge a lot of cells exactly like in this thread, but I'm kind of new to coding and especially excel/VBA so I don't get it to work. I have the same scenario (except I don't have any empty rows) so I just tried to use the code in the existing thread not really understanding the syntax:

Sub mergecolumn()

Dim cnt As Integer
Dim rng As Range
Dim str As String

For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
cnt = Cells(i, 1).MergeArea.Count
Set rng = Range(Cells(i, 2), Cells(i - cnt + 1, 2))

For Each cl In rng
    If Not IsEmpty(cl) Then str = str + vbNewLine + cl
Next
If str <> "" Then str = Right(str, Len(str) - 2)

Application.DisplayAlerts = False
rng.Merge
rng = str
Application.DisplayAlerts = True

str = ""
i = i - cnt + 1
Next i

End Sub

I've tried to run the macro in different ways marking multiple columns, marking multiple rows and marking just some area but I'm always getting:

Run-time error '13':
Type mismatch

When I go to debug screen this is marked:

str = str + vbNewLine + cl

I added the macro through Developer-ribbon->Visual Basic->Insert->Module and just pasted the code there and saved it.

Thanks in advance for any help
//Joakim

I created an Add-In long time ago which exactly does what you want. Let me see if I can get the code. — Siddharth Rout, Sep 13 '13 at 11:16

score 2 · Accepted Answer · answered Sep 13 '13 at 11:34

Here are two versions of the code.

VER 1 (Doesn't ignore Blank Cells)

'~~> For Group MERGING (Merge Cells and Keep All text)
Public Sub Sample()
    On Error GoTo ErrMergeAll

    Application.DisplayAlerts = False

    Dim Cl As Range
    Dim strTemp As String

    '~~> Collect values from all the cells and separate them with spaces
    For Each Cl In Selection
        If Len(Trim(strTemp)) = 0 Then
            strTemp = strTemp & Cl.Value
        Else
            strTemp = strTemp & vbNewLine & Cl.Value
        End If
    Next

    strTemp = Trim(strTemp)

    '~~> Merging of cells
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = False
    End With
    Selection.Merge

    '~~> Set new value of the range
    Selection.Value = strTemp

    Application.DisplayAlerts = True
    Exit Sub

ErrMergeAll:
    MsgBox Err.Description, vbInformation
    Application.DisplayAlerts = True
End Sub

VER 2 (Ignores Blank Cells)

'~~> For Group MERGING (Merge Cells and Keep All text)
Public Sub Sample()
    On Error GoTo ErrMergeAll

    Application.DisplayAlerts = False

    Dim Cl As Range
    Dim strTemp As String

    '~~> Collect values from all the cells and separate them with spaces
    For Each Cl In Selection
        If Len(Trim(Cl.Value)) <> 0 Then
            If Len(Trim(strTemp)) = 0 Then
                strTemp = strTemp & Cl.Value
            Else
                strTemp = strTemp & vbNewLine & Cl.Value
            End If
        End If
    Next

    strTemp = Trim(strTemp)

    '~~> Merging of cells
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = False
    End With
    Selection.Merge

    '~~> Set new value of the range
    Selection.Value = strTemp

    Application.DisplayAlerts = True
    Exit Sub

ErrMergeAll:
    MsgBox Err.Description, vbInformation
    Application.DisplayAlerts = True
End Sub

SCREENSHOT

enter image description here

That looks exactly like what I need. Now I just need to figure out how to create Add-Ins in excel. =) — user2775737, Sep 13 '13 at 11:46
Would [THIS](http://stackoverflow.com/questions/8850836/how-to-add-a-custom-ribbon-tab-using-vba) Help? :) — Siddharth Rout, Sep 13 '13 at 11:47
It sure looks like it would. Thanks a lot! You're the man. :D — user2775737, Sep 13 '13 at 12:00

Merging cells in Excel without loosing data

1 Answers1