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
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
Tags: excelexcel
