Concatenate cells in column until second blank

[hashasu]

Hello!

I am working on a similar project in this thread: https://www.mrexcel.com/forum/excel...catenate-cells-column-until-blank-cell-2.html

However, I need to loop it once so that the process only completes on the second blank. For example my current data looks like this:

IMG

 

[hashasu]

For clarification, column one is current data, column two is desired outcome (except I have to apply this formatting to thousands of rows in one column)

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub JoinData()

   Dim i As Long
   Dim Ar As Areas
   
   Set Ar = Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
   
   For i = 1 To Ar.Count Step 2
      Range("B" & i).Value = Ar(i) & Chr(10) & Join(Application.Transpose(Ar(i + 1)), Chr(10))
   Next i
End Sub

 

[hashasu]

Thank you!

It's very close, however the current output is being placed every other row, instead of preserving the row the name is on.

For example in the original image, Jane Doe's information is appearing in row 3 instead of row 7.

 

[Fluff]

Ok, how about

Sub JoinData()

   Dim i As Long
   Dim Ar As Areas
   
   Set Ar = Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
   
   For i = 1 To Ar.Count Step 2
      Ar(i).Offset(, 1).Value = Ar(i) & Chr(10) & Join(Application.Transpose(Ar(i + 1)), Chr(10))
   Next i
End Sub

 

[hashasu]

You are a saint and a wizard. Thank you so much!!!

 

[Fluff]

Glad to help & thanks for the feedback