Many rows to One row

[RAB]

I have data that looks like this:

199 7/20/2004 1Z9952220245265501
199 7/20/2004 1Z9952220245959119
199 7/20/2004 1Z9952220244763322
200 7/21/2004 1Z9952220244788457

I need the data to look like this: (commas or spaces) doesn't matter

199,7/20/2004,1Z9952220245265501,1Z9952220245959119,1Z9952220244763322
200,7/21/2004,1Z9952220244788457

 

[Gord Dibben]

RAB

Looks like you want the results to be placed in one cell, not one row.

Sub ConCat_Cells()
Dim x As Range
Dim y As Range
Dim z As Range
Dim w As String
Dim sbuf As String
On Error GoTo endit
w = InputBox("Enter the Type of De-limiter Desired")
Set z = Application.InputBox("Select Destination Cell", _
"Destination Cell", , , , , , 8)
Application.SendKeys "+{F8}"
Set x = Application.InputBox("Select Cells...Contiguous or _
Non-Contiguous", "Cells Selection", , , , , , 8)
For Each y In x
If Len(y.text) > 0 Then sbuf = sbuf & y.text & w
Next
z = Left(sbuf, Len(sbuf) - 1)
Exit Sub
endit:
MsgBox "Nothing Selected. Please try again."
End Sub

Gord Dibben Excel MVP

 

[RAB]

Thank you so much.....

RAB

Looks like you want the results to be placed in one cell, not one row.

Sub ConCat_Cells()
Dim x As Range
Dim y As Range
Dim z As Range
Dim w As String
Dim sbuf As String
On Error GoTo endit
w = InputBox("Enter the Type of De-limiter Desired")
Set z = Application.InputBox("Select Destination Cell", _
"Destination Cell", , , , , , 8)
Application.SendKeys "+{F8}"
Set x = Application.InputBox("Select Cells...Contiguous or _
Non-Contiguous", "Cells Selection", , , , , , 8)
For Each y In x
If Len(y.text) > 0 Then sbuf = sbuf & y.text & w
Next
z = Left(sbuf, Len(sbuf) - 1)
Exit Sub
endit:
MsgBox "Nothing Selected. Please try again."
End Sub

Gord Dibben Excel MVP