Concatenate Problem

JayLee

Board Regular
Joined
Sep 23, 2002
Messages
52
Is there code in order to get the concatenated results which are in column c?
Book1
ABCDE
1DescriptionStockTicker
2JMSsystemsJMSJMSsystemsboughtat100.5
3boughtat
4100.5
5TheFarSideFSATheFarSideoftheroad
6oftheroad
Sheet1
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

JayLee

Board Regular
Joined
Sep 23, 2002
Messages
52
I have code that did concatenated the results into a column only if there were spaces between the description. Now the data is changed and there are no longer any more spaces. Here is the code:

Sub Concatenate()
'Concatenate Rows
Dim Rng As Range
Dim x As Long
Dim y As Integer
Dim Txt As String
' *** Change column and starting row to suit ***
Set Rng = Range("D3:D" & Range("D65536").End(xlUp).Row)
x = 1
y = 1
Do
Txt = Rng.Cells(x, 1)
Do
If IsEmpty(Rng.Cells(x, 1).Offset(y, 0)) Then
Rng.Cells(x, 1).Offset(0, 4) = Txt
x = x + y + 1
y = 1
Exit Do
Else
Txt = Txt & Rng.Cells(x, 1).Offset(y, 0)
y = y + 1
End If
Loop
Loop While x <= Rng.Rows.Count
Range("A:A").SpecialCells(xlBlanks).EntireRow.Delete
Range("H2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("D2").Select
ActiveSheet.Paste

End Sub

Now i want to modify this code to concatenate to the previous row if a cell in column B is empty.
 

JayLee

Board Regular
Joined
Sep 23, 2002
Messages
52

ADVERTISEMENT

Can anyone help me with this?
 

attc

Board Regular
Joined
Oct 11, 2002
Messages
87
This slightly modified code should do the trick (based on the data as per your example):

Sub Concatenate()
'Concatenate Rows
Dim Rng As Range
Dim x As Long
Dim y As Integer
Dim Txt As String
' *** Change column and starting row to suit ***
Set Rng = Range("A2:A" & Range("A65536").End(xlUp).Row)
x = 1
y = 1
Do
Txt = Rng.Cells(x, 1)

Do
If IsEmpty(Rng.Cells(x, 1).Offset(y, 1)) And x + y <= Rng.Rows.Count Then

Txt = Txt & " " & Rng.Cells(x, 1).Offset(y, 0)
y = y + 1
Debug.Print "1 " & Txt

Else

Rng.Cells(x, 1).Offset(0, 2) = Txt
x = x + y
y = 1
Exit Do

End If

Loop While x + y <= Rng.Rows.Count + 1
Loop While x <= Rng.Rows.Count

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,123,115
Messages
5,599,809
Members
414,341
Latest member
Mohammedsobhey

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top