Concatenate with line break

[rps199]

Hello All!

I'm hoping someone can please help me with a formula that used to work back in 2015 but now I need it again and it's not quite working right and I've lost too many hours trying to work it out.

This is what I'm failing to achieve.

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

A	B
Fruit	Banana
	Apple
	Strawberry
Veg	Carrot
	Broccoli
	Peas
	Potatoes
	Leeks

<tbody>
</tbody>

So I need to combine the answers in B into a single cell like this A B Fruit Banana Apple Strawberry Veg Carrot Broccoli Peas Potatoes Leeks <tbody> </tbody>

<tbody>
</tbody>

The formula I was kindly given is below. My problem is the script runs but then stops on the first value in column A. I have over 5,000 values in column A so impossible to do one by one.

Many thanks in advance to anyone who can help!

Here is the original thread for reference.
https://www.mrexcel.com/forum/excel-questions/845809-concatenate-line-break-help-please.html

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

 

[Fluff]

Re: Concatenate with line break - help please!! Code is not working!

How about

Sub Concat()
   
   Dim Rng As Range
   
   For Each Rng In Columns(2).SpecialCells(xlConstants).Areas
      Rng.Resize(1).Value = Join(Application.Transpose(Rng), vbLf)
   Next Rng
   [COLOR=#0000ff]Columns(1).SpecialCells(xlBlanks).EntireRow.Delete[/COLOR]
   
End Sub

This also deletes the extra rows, if you don't want that then remove the line in blue

 

[rps199]

Re: Concatenate with line break - help please!! Code is not working!

Thank you very much for taking the time to look at this. The code works but not quite as I need it! It merges the entire column B into one cell rather than stopping when it finds another value in A and merging that section. Also need a carriage return after every line column B.

Is this possible with your code?

 

[Fluff]

Re: Concatenate with line break - help please!! Code is not working!

In the sample data you supplied there is a blank row, between the col B groups. If that is not what your data is like, could you please post an accurate sample of your data?

 

[rps199]

Re: Concatenate with line break - help please!! Code is not working!

In the sample data you supplied there is a blank row, between the col B groups. If that is not what your data is like, could you please post an accurate sample of your data?

1000 apologies! Your code is perfect. The data sample I tested it on didn't have spaces! looking at the actual data I need to sort I can see that in some areas the space is missing.

Thanks again!

 

[Fluff]

Re: Concatenate with line break - help please!! Code is not working!

Ok, if some are missing the blank row, try this

Sub Concat()
   
   Dim Rng As Range
   
   For Each Rng In Columns(1).SpecialCells(xlBlanks).Areas
      Rng.Offset(-1, 1).Resize(1).Value = Join(Application.Transpose(Rng.Offset(-1, 1).Resize(Rng.Count + 1)), vbLf)
   Next Rng
   Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
   
End Sub

 

[rps199]

Re: Concatenate with line break - help please!! Code is not working!

Ok, if some are missing the blank row, try this

Sub Concat()
   
   Dim Rng As Range
   
   For Each Rng In Columns(1).SpecialCells(xlBlanks).Areas
      Rng.Offset(-1, 1).Resize(1).Value = Join(Application.Transpose(Rng.Offset(-1, 1).Resize(Rng.Count + 1)), vbLf)
   Next Rng
   Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
   
End Sub

This is perfect! You have saved me many hours work. Thanks a million!!

 

[Fluff]

Re: Concatenate with line break - help please!! Code is not working!

Glad to help & thanks for the feedback