Wrap Text of Several Rows

[tkat92]

Hello,

I have around 20 rows of text and I want to wrap them all into one cell. Manually I would have to do the following:

1. Copy text
2. Paste the text into the cell
3. Press Alt + Enter (From where I want the characters to start on a new line)

The data set I have is huge. Is there an efficient way for me to do this? I have included a table below FYI. Italicized data is how I have the cells. Underlined is how I want them. THANKS![TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Public - 20%[/TD]
[/TR]
[TR]
[TD]Private - 40%[/TD]
[/TR]
[TR]
[TD]Sell - 30%[/TD]
[/TR]
[TR]
[TD]Remain - 10%[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]Public -20%
Private - 40%
Sell - 30%
Remain - 10%[/TD]
[/TR]
</tbody>[/TABLE]

 

[tonyyy]

tkat92,

Welcome to the Board.

If you're comfortable with a vba approach...

Sub ConcatenateText()
Dim arr As Variant, i As Long, txt As String
arr = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For i = LBound(arr) To UBound(arr)
    If txt <> "" Then
        txt = txt & Chr(10) & arr(i, 1)
    Else
        txt = arr(i, 1)
    End If
Next i
Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).Value = txt
End Sub

Cheers,

tonyyy

 

[Rick Rothstein]

If you're comfortable with a vba approach...

Sub ConcatenateText()
Dim arr As Variant, i As Long, txt As String
arr = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For i = LBound(arr) To UBound(arr)
    If txt <> "" Then
        txt = txt & Chr(10) & arr(i, 1)
    Else
        txt = arr(i, 1)
    End If
Next i
Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).Value = txt
End Sub

You can also do that with just a single line of code (albeit a rather long one)...

[table="width: 500"]
[tr]
	[td]Sub ConcatenateText2()
  Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).Value = Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))), vbLf)
End Sub[/td]
[/tr]
[/table]

 

[tonyyy]

You can also do that with just a single line of code...

Show off!

 

[tkat92]

Thanks!