VBA: Concatenate with carriage returns

[Rob]

I think this might be an interesting challenge for someone!

I want to concatenate text in three columns, which would normally be a
simple worksheet function.

However, if we look at the cells across the three columns, each contains a
set
of data using carriage returns (essentially like an Alt-Enter).

I have no control over the way this data is fed to me as it comes from a
database I subscribe to. To put some context on the problem, A is First Name,
B is Middle Name, C is Surname.

The data would look like:
A B C
1 David Robert Hughes
Mark Dave Marriott
Martin Benjamin Murray
2 Shaun Andrew Flannagan
Alison Jane Martin

So I would like to combine the data into some sort of output that will lead
to the following, with each:
1 David Robert Hughes
Mark Dave Marriott
Martin Benjamin Murray
2 Shaun Andrew Flannagan
Alison Jane Martin

It is worth noting that some cells may contain no carriage return entries,
while others may have anything up to 20 returns.

After some thought, it would make sense for the data to stay in carriage
return format as no further Excel analysis needs to be performed, and my next
step will be to import the data from each cell into PowerPoint for
presentation purposes, with each cell imported to a seperate slide in a
PowerPoint presentation.

After posting on the Worksheet Functions forum that the only way to do this
without VBA looks to be by using the Text to Columns feature and specifying
the carriage returns as the deliminator. This is very messy and would result
in extra rows.

I have basis working knowledge of VBA, so should be able to decypher a reply!

Is anyone able to help with some VBA script (marked-up so I can see what its
doing!) and pointers?

Many thanks,

Rob

 

[Tom Ogilvy]

Sub AAA()
Dim rng As Range
Dim cell As Range
Dim v1, v2, c3, v4
Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cell In rng
v1 = Split(cell, Chr(10))
v2 = Split(cell.Offset(0, 1), Chr(10))
v3 = Split(cell.Offset(0, 2), Chr(10))
ReDim v4(LBound(v1) To UBound(v1))
For i = LBound(v1) To UBound(v1)
Debug.Print i, v1(i), v2(i), v3(i)
v4(i) = v1(i) & " " & v2(i) & " " & v3(i)
Next
sStr = Join(v4, Chr(10))
cell.Value = sStr
cell.Offset(0, 1).Resize(1, 2).ClearContents
Next
End Sub

Test it on a copy of your data.

 

[Rob]

Great, I'll give it a try tonight and let you know...

Thanks
Rob