Concatenate Loop

[FIRSTROUNDKO via OfficeKB.com]

Hi!

I have two collums of data

CAR
BUS
1 TRAIN
PLANE
2 MOTORBIKE
SCOOTER
HELICOPTER
3 TRAM

I would like to run a loop which concatenated my data based upon the first
collumn (as below)

CAR
BUS
1 TRAIN CARBUSTRAIN
PLANE
2 MOTORBIKE PLANEMOTORBIKE
SCOOTER
HELICOPTER
3 TRAM SCOOTERHELICOPTERTRAM

Thanks in advance

Darren

 

[Ardus Petus]

This will need some VBA macro code. Do you mind?

 

[FIRSTROUNDKO via OfficeKB.com]

Ardus,

that would be just great.

Darren

This will need some VBA macro code. Do you mind?

--
AP

Hi!

[quoted text clipped - 24 lines]

Darren

 

[Ardus Petus]

Paste following code in a Module:

'-------------------------------------
Sub concat()
'Cell address of 1st vehicle to be processed
Const strFirstVehicle = "B1"
'assume rank is one column to the left
'and result one column to the right
Dim rng As Range
Dim strResult As String

'Initialize
strRsult = ""
Set rng = Range(strFirstVehicle)

'Loop
Do While rng.Value <> ""
strResult = strResult & rng.Value
If rng.Offset(0, -1).Value <> "" Then
rng.Offset(0, 1) = strResult
strResult = ""
End If
Set rng = rng.Offset(1, 0)
Loop
End Sub
'----------------------------------------

HTH
--
AP

Ardus,

that would be just great.

Darren

This will need some VBA macro code. Do you mind?

--
AP

Hi!

[quoted text clipped - 24 lines]

Darren

 

[FIRSTROUNDKO via OfficeKB.com]

AP,

Thats just awesome

Thanks

Darren

Paste following code in a Module:

'-------------------------------------
Sub concat()
'Cell address of 1st vehicle to be processed
Const strFirstVehicle = "B1"
'assume rank is one column to the left
'and result one column to the right
Dim rng As Range
Dim strResult As String

'Initialize
strRsult = ""
Set rng = Range(strFirstVehicle)

'Loop
Do While rng.Value <> ""
strResult = strResult & rng.Value
If rng.Offset(0, -1).Value <> "" Then
rng.Offset(0, 1) = strResult
strResult = ""
End If
Set rng = rng.Offset(1, 0)
Loop
End Sub
'----------------------------------------

HTH
--
AP

Ardus,

[quoted text clipped - 12 lines]