VBA Concatenate Rows

[ShuStar]

To All - the final thing I need to do here is to concatenate the row into a new column. Any ideas on how i can achieve this?

Ultimately, for each row starting from D3 to nth Column, I want to insert a new column to my table after Column C and just concatenate that row (after it has changed Ys to that of the column header).

There may be a better way to do it without changing Ys to Column Header name etc but the flow in my head is:
-after changing the Ys to that of the name of column header then
-insert a new column after column C, which becomes new Column D (purpose for holding concatenated values) and then concatenate the rows from Column E to nth Column
-should look like "Banana, Apples, Lemon" and not "Banana, Apples , , Lemon" as there may be blank cells from the start column to end column - example below)

Sub ChangeTable()
'the below finds "Y" in a cell and replaces it to that of the name of its respective Column Header;
'I would like to adapt this code to include the functionality that after replacing Ys to that of the name of the column header, add a column after Column C and Concatenate the Row


Dim lr As Long, lc As Long, i As Long

lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row

lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column

    For i = 4 To lc

        Columns(i).Replace "Y", Cells(2, i), xlWhole

    Next i

End Sub

Example:

When executing above code, the table looks like:

ID	Name	Count	Banana	Apples	Nectarine	Lemon	...to nColumn
12345	John	1	Banana
12345	Sara	4	Banana	Apples	Nectarine		...to nColumn
12345	Alex	3	Banana	Apples		Lemon	...to nColumn
...to nRow	###	###	###	###	###		###

Would want adapt above code to Concatenated the rows: (note new Concatenated column added):

ID	Name	Count	Concatenated	Banana	Apples	Nectarine	Lemon	...to nColumn
12345	John	1	Banana, Apples	Banana
12345	Sara	4	Banana, Apples, Nectarine	Banana	Apples	Nectarine		...to nColumn
12345	Alex	4	Banana, Apples, Lemon	Banana	Apples		Lemon	...to nColumn
...to nRow	###	###		###	###	###		###

Thanks inadvance Gurus, appreciate the help.

 

[ShuStar]

Brilliant, thank you very much. This is working too! Would like to thank everyone for their support!!

 

[Peter_SSs]

You're welcome. Glad we could help.

BTW, we can do both jobs on the same pass through if you want (though it may actually be slower to do it this way. ).

Sub Concat_Fruit_v2()
  Dim HdrAddr As String, LastCol As String
  Dim Rw As Range
  
  Columns(4).Insert
  LastCol = Split(Cells(2, Columns.Count).End(xlToLeft).Address, "$")(1)
  HdrAddr = "E2:" & LastCol & 2
  For Each Rw In Range("E3:" & LastCol & Range("A" & Rows.Count).End(xlUp).Row).Rows
    Rw.Cells(0).Value = Replace(Join(Filter(Evaluate(HdrAddr & "&""|""&" & Rw.Address), "|Y"), ", "), "|Y", "")
    Rw.Value = Evaluate("if(" & Rw.Address & "="""",""""," & HdrAddr & ")")
  Next Rw
  Columns(4).AutoFit
End Sub