Merge Cells

[Steve Drenker]

Hi...There have been many posts about merging cells, but I haven't seen this
issue addressed.

I want to take several cells in a column and merge them into one cell
separated by return characters. Example:

Input cells:
- - - - - -
| Bob | A1
- - - - - -
| Joe | A2
- - - - - -
| Ken | A3
- - - - - -

Desired result after merge:
- - - - - -
| Bob |
| Joe | A1
| Ken |
- - - - - -
| <blank> | A2
- - - - - -
| <blank> | A3
- - - - - -

I can create the result by manually entering returns via
Option-Command-Return on my Mac and (IIRC) Ctrl-Return on my PC.

I wrote the following macro to automate the merge. Unfortunately, the
inserted CRs are not recognized in the merged cell (i.e., I get BobJoeKen in
A1):

Sub MergeCells()
Dim rng As Range
Dim cell As Range
Dim OutStr As String

Set rng = Intersect(Selection, ActiveSheet.UsedRange)

If rng Is Nothing Then
MsgBox "Select a range to be merged"
GoTo done
End If

For Each cell In rng
OutStr = OutStr & cell.Text & Chr(13)
Next cell

OutStr = Left(OutStr, Len(OutStr) - 1) ' Strip off final CR
rng.ClearContents ' Clear original selected range
rng.Cells(1).Value = OutStr ' Put new string into top cell
done:
End Sub

Yet, if I manually enter A (CR) B (CR) C into a cell and run the following
macro, I see that the three lines are indeed separated by two Chr(13). What
am I missing?

Sub GetSeparatorChar()
' Select one cell with "A," "B," and "C" in it separated by
' carriage returns (CR)
Dim c As String
Dim i As Integer

For i = 1 To Len(Selection.Text)
Debug.Print Asc(Mid(Selection.Text, i, 1))
Next i

End Sub

 

[JLGWhiz]

I don't think so.