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.

AB
FruitBanana
Apple
Strawberry
VegCarrot
Broccoli
Peas
Potatoes
Leeks

<tbody>
</tbody>

So I need to combine the answers in B into a single cell like this
AB
FruitBanana
Apple
Strawberry
VegCarrot
Broccoli
Peas
Potatoes
Leeks

<tbody>
</tbody>

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!!!

<tbody>
</tbody>
 
Last edited:

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
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
Try adding Option Explicit to the top of the code.

Code:
Option Explicit
Sub Macro()
.....
 
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,216,058
Messages
6,128,532
Members
449,456
Latest member
SammMcCandless

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