Concatenate with line break - help please!!

rps199

New Member
Joined
Mar 31, 2015
Messages
10
Hi All,

I'm really hoping somebody can help with this!

Here's an example to give you an idea of the structure I'm working with, values in B are on separate rows.

[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]Fruit[/TD]
[TD]Banana[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Strawberry[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Veg[/TD]
[TD]Carrot[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Broccoli[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Peas[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Potatoes[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Leeks[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 519"]
<tbody>[TR]
[TD]So I need to combine the answers in B into a single cell like this
[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]Fruit[/TD]
[TD]Banana
Apple
Strawberry[/TD]
[/TR]
[TR]
[TD]Veg[/TD]
[TD]Carrot
Broccoli
Peas
Potatoes
Leeks[/TD]
[/TR]
</tbody>[/TABLE]

Now I can do this for each part number but have over 3,000 to do and they all have varying amounts of data to combine into 1 cell, it would take forever. There is a line space between each grouping just like the first table

Does anybody know how I can achieve this quickly with a formula or VBA?

Many thanks for any help!!![/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
So this is a macro to do it for you. Hope it works!

Code:
Sub Macro()    
    Dim totalRows As Integer
    Dim arrIndexes() As Integer
    Dim intIndexesCount As Integer
    Dim temp As String
    intIndexesCount = 0
    
    totalRows = Sheet1.Range("B1").End(xlDown).Row
    
    ReDim arrIndexes(totalRows)
    
    ' Gets the indexes of the Cells in column A which have a value
    For Index = 1 To Sheet1.Range("B1").End(xlDown).Row
        If Cells(Index, "A") <> "" Then
            arrIndexes(intIndexesCount) = Index
            intIndexesCount = intIndexesCount + 1
        End If
    Next
    
    ' Adds all the values of column B together in one cell
    For i = 0 To intIndexesCount - 1
        temp = ""
        
        If i + 1 > intIndexesCount - 1 Then
            upperLimit = totalRows
        Else
            upperLimit = arrIndexes(i + 1) - 1
        End If
        
        For RowIndex = arrIndexes(i) To upperLimit
            temp = temp & Cells(RowIndex, "B")
        Next
        
        Cells(arrIndexes(i), "B") = temp
        
    Next
    
End Sub
 
Upvote 0
So this is a macro to do it for you. Hope it works!

Code:
Sub Macro()    
    Dim totalRows As Integer
    Dim arrIndexes() As Integer
    Dim intIndexesCount As Integer
    Dim temp As String
    intIndexesCount = 0
    
    totalRows = Sheet1.Range("B1").End(xlDown).Row
    
    ReDim arrIndexes(totalRows)
    
    ' Gets the indexes of the Cells in column A which have a value
    For Index = 1 To Sheet1.Range("B1").End(xlDown).Row
        If Cells(Index, "A") <> "" Then
            arrIndexes(intIndexesCount) = Index
            intIndexesCount = intIndexesCount + 1
        End If
    Next
    
    ' Adds all the values of column B together in one cell
    For i = 0 To intIndexesCount - 1
        temp = ""
        
        If i + 1 > intIndexesCount - 1 Then
            upperLimit = totalRows
        Else
            upperLimit = arrIndexes(i + 1) - 1
        End If
        
        For RowIndex = arrIndexes(i) To upperLimit
            temp = temp & Cells(RowIndex, "B")
        Next
        
        Cells(arrIndexes(i), "B") = temp
        
    Next
    
End Sub

Thanks for your reply! I've tried this but the something is not quite right. Its saying it requires the variable for Index.
I put a variable in and then i got a runtime error 6 - overflow.
Any ideas?
 
Upvote 0
If that doesn't work try changing Index to j or some other variable name.

Code:
Sub Macro()    Dim totalRows As Integer
    Dim arrIndexes() As Integer
    Dim intIndexesCount As Integer
    Dim temp As String
    intIndexesCount = 0
    
    totalRows = Sheet1.Range("B1").End(xlDown).Row
    
    ReDim arrIndexes(totalRows)
    
    ' Gets the indexes of the Cells in column A which have a value
[B]    For j= 1 To Sheet1.Range("B1").End(xlDown).Row[/B]
[B]        If Cells(j, "A") <> "" Then[/B]
[B]            arrIndexes(intIndexesCount) = j[/B]
[B]            intIndexesCount = intIndexesCount + 1[/B]
[B]        End If[/B]
[B]    Next[/B]
    
    ' Adds all the values of column B together in one cell
    For i = 0 To intIndexesCount - 1
        temp = ""
        
        If i + 1 > intIndexesCount - 1 Then
            upperLimit = totalRows
        Else
            upperLimit = arrIndexes(i + 1) - 1
        End If
        
        For RowIndex = arrIndexes(i) To upperLimit
            temp = temp & Cells(RowIndex, "B")
        Next
        
        Cells(arrIndexes(i), "B") = temp
        
    Next
    
End Sub
 
Upvote 0
If that doesn't work try changing Index to j or some other variable name.

Code:
Sub Macro()    Dim totalRows As Integer
    Dim arrIndexes() As Integer
    Dim intIndexesCount As Integer
    Dim temp As String
    intIndexesCount = 0
    
    totalRows = Sheet1.Range("B1").End(xlDown).Row
    
    ReDim arrIndexes(totalRows)
    
    ' Gets the indexes of the Cells in column A which have a value
[B]    For j= 1 To Sheet1.Range("B1").End(xlDown).Row[/B]
[B]        If Cells(j, "A") <> "" Then[/B]
[B]            arrIndexes(intIndexesCount) = j[/B]
[B]            intIndexesCount = intIndexesCount + 1[/B]
[B]        End If[/B]
[B]    Next[/B]
    
    ' Adds all the values of column B together in one cell
    For i = 0 To intIndexesCount - 1
        temp = ""
        
        If i + 1 > intIndexesCount - 1 Then
            upperLimit = totalRows
        Else
            upperLimit = arrIndexes(i + 1) - 1
        End If
        
        For RowIndex = arrIndexes(i) To upperLimit
            temp = temp & Cells(RowIndex, "B")
        Next
        
        Cells(arrIndexes(i), "B") = temp
        
    Next
    
End Sub

Thanks very much for your help! I've managed to get it working to a point, It now combines into 1 cell however it has not actually split the data with a carriage return? The data does have commas, not sure if that would cause a problem?
 
Upvote 0
I added a few lines to fix that.

Code:
Sub Macro()
    Dim totalRows As Integer
    Dim arrIndexes() As Integer
    Dim intIndexesCount As Integer
    Dim temp As String
    intIndexesCount = 0
    
    totalRows = Sheet1.Range("B1").End(xlDown).Row
    
    ReDim arrIndexes(totalRows)
    
    ' Gets the indexes of the Cells in column A which have a value
    For j = 1 To Sheet1.Range("B1").End(xlDown).Row
        If Cells(j, "A") <> "" Then
            arrIndexes(intIndexesCount) = j
            intIndexesCount = intIndexesCount + 1
        End If
    Next
    
    ' Adds all the values of column B together in one cell
    For i = 0 To intIndexesCount - 1
        temp = ""
        
        If i + 1 > intIndexesCount - 1 Then
            upperLimit = totalRows
        Else
            upperLimit = arrIndexes(i + 1) - 1
        End If
        
        For RowIndex = arrIndexes(i) To upperLimit
            temp = temp & Cells(RowIndex, "B") & vbNewLine
        Next
        
        Cells(arrIndexes(i), "B") = Left(temp, Len(temp) - 1)
        
    Next
    
    Sheet1.Columns("B").EntireColumn.AutoFit
    
End Sub
 
Upvote 0
I added a few lines to fix that.

Code:
Sub Macro()
    Dim totalRows As Integer
    Dim arrIndexes() As Integer
    Dim intIndexesCount As Integer
    Dim temp As String
    intIndexesCount = 0
    
    totalRows = Sheet1.Range("B1").End(xlDown).Row
    
    ReDim arrIndexes(totalRows)
    
    ' Gets the indexes of the Cells in column A which have a value
    For j = 1 To Sheet1.Range("B1").End(xlDown).Row
        If Cells(j, "A") <> "" Then
            arrIndexes(intIndexesCount) = j
            intIndexesCount = intIndexesCount + 1
        End If
    Next
    
    ' Adds all the values of column B together in one cell
    For i = 0 To intIndexesCount - 1
        temp = ""
        
        If i + 1 > intIndexesCount - 1 Then
            upperLimit = totalRows
        Else
            upperLimit = arrIndexes(i + 1) - 1
        End If
        
        For RowIndex = arrIndexes(i) To upperLimit
            temp = temp & Cells(RowIndex, "B") & vbNewLine
        Next
        
        Cells(arrIndexes(i), "B") = Left(temp, Len(temp) - 1)
        
    Next
    
    Sheet1.Columns("B").EntireColumn.AutoFit
    
End Sub

For some unknown reason another problem has just happened. Before the code was working perfectly just needed to add a return. This code does that perfectly but now it doesn't do the whole sheet, just the first number it comes to on column A. I've gone over the code and I can't see why it would do that!???? I hate excel gremlins!
 
Upvote 0
For some unknown reason another problem has just happened. Before the code was working perfectly just needed to add a return. This code does that perfectly but now it doesn't do the whole sheet, just the first number it comes to on column A. I've gone over the code and I can't see why it would do that!???? I hate excel gremlins!


All sorted!! I completely overlooked changing the sheet number in the code. All works perfectly. Thank you so much mhillmann!!
 
Upvote 0

Forum statistics

Threads
1,223,990
Messages
6,175,817
Members
452,672
Latest member
missbanana

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
Back
Top