VBA Merge cells comma delimited

[decadence]

Hi, i am trying to merge cells together comma delimited, I am almost there but need help, Can someone help with this please.

Sub MergeCommaDel()
'
    Dim objSelection, objCell As range, MyStr As String
    
    Application.ScreenUpdating = False
    On Error Resume Next
    Set objSelection = Intersect(Selection, ActiveSheet.UsedRange)
    
    For Each objCell In objSelection
            MyStr = MyStr & VBA.Trim$(objCell) & ","
    Next
    
    With ActiveWindow
        .Selection(1, 1).NumberFormat = "@"
        .Selection(1, 1).Value = MyStr
    End With
    
End Sub

This is what I end up with so far
[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]a,b,c,d,[/TD]
[TD]b[/TD]
[TD]c[/TD]
[TD]d[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

But What I would like to do is this

From This
[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]a[/TD]
[TD]b[/TD]
[TD]c[/TD]
[TD]d[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


To This

[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]a,b,c,d[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[Rick Rothstein]

Hi all, The codes posted does this for cells but how would i get the same results if columns are selected, any help would be appreciated

From This

[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]a[/TD]
[TD]b[/TD]
[TD]c[/TD]
[TD]d[/TD]
[TD]e[/TD]
[/TR]
[TR]
[TD]f[/TD]
[TD]g[/TD]
[TD]h[/TD]
[TD]i[/TD]
[TD]j[/TD]
[/TR]
[TR]
[TD]k[/TD]
[TD]l[/TD]
[TD]m[/TD]
[TD]n[/TD]
[TD]o[/TD]
[/TR]
[TR]
[TD]p[/TD]
[TD]q[/TD]
[TD]r[/TD]
[TD]s[/TD]
[TD]t[/TD]
[/TR]
</tbody>[/TABLE]


To This


[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]a,b,c,d,e[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]f,g,h,i,j[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]k,l,m,n,o[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]p,q,r,s,t[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Select all of the cells you want to process (assumed to be A1:E4 for the above example although the following code will work no matter where the values are located) and then give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub MergeCommaDelimit()
  Dim Cell As Range
  For Each Cell In Selection.Columns(1).Cells
    Cell.Value = Join(Application.Index(Selection.Value, Cell.Row - Selection.Row + 1, 0), ", ")
  Next
  Selection.Offset(, 1).Resize(, Selection.Columns.Count - 1).ClearContents
End Sub[/td]
[/tr]
[/table]