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.

 

[Rick Rothstein]

Give this macro a try...

Sub ConcatFruit()
  Dim R As Long, LastCol As Long
  Columns("D").Insert
  LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  For R = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    Cells(R, "D") = Replace(Replace(Application.Trim(Join(Evaluate("IF({1},SUBSTITUTE(" & Range(Cells(R, 5), Cells(R, LastCol)).Address & ","" "",""|""))"), " ")), " ", ", "), "|", " ")
  Next
  Columns("D").AutoFit
End Sub

 

[Peter_SSs]

@ShuStar

I suggest that you update your Account details (click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[ShuStar]

Thanks Peter_SSs - Using Windows and MS Office 2010 (profile has been updated to reflect accordingly).

Rick Rothstein - thank you for your help... everything is good except its concatenating the wrong columns. Your macro has concatenated Columns A, B, C but what I need it to concatenate (after inserting new column in D) is Columns E to nth Column for that row. Unfortunately I don't know how to adapt your code to correct it.


Your code has done this:

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

But need it to do as below if possible:

ID	Name	Count	Concatenated	Banana	Apples	Nectarine	Lemon	...to nColumn
12345	John	1	Banana	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	###	###		###	###	###		###

 

[Rick Rothstein]

Rick Rothstein - thank you for your help... everything is good except its concatenating the wrong columns. Your macro has concatenated Columns A, B, C but what I need it to concatenate (after inserting new column in D) is Columns E to nth Column for that row. Unfortunately I don't know how to adapt your code to correct it.

That is not possible with the code I posted in Message #2... my code deliberately concatenates Columns E rightward after first inserting a column between Column C and D, then puts the output in the newly inserted column. Just to be sure, I copied the data you posted into a blank sheet and tested the code... it worked exactly like I designed it to... it definitely does not concatenated Columns A, B and C. I suggest you try it again and make sure you are running the code I posted exactly like I posted it.

 

[ShuStar]

Rick - not sure whats happening. Below is the code i am using. Image is the results when these are executed

Sub ChangeYtoColumnHeader()
Dim lr As Long, lc As Long, i As Long

      If Range("B3").Value = "" Then Exit Sub
            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


Sub ConcatFruit()
  Dim R As Long, LastCol As Long
  Columns("D").Insert
  LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  For R = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    Cells(R, "D") = Replace(Replace(Application.Trim(Join(Evaluate("IF({1},SUBSTITUTE(" & Range(Cells(R, 5), Cells(R, LastCol)).Address & ","" "",""|""))"), " ")), " ", ", "), "|", " ")
  Next
  Columns("D").AutoFit
End Sub

 

[Rick Rothstein]

The problem is I assumed your header were in the normal location of Row 1; however, your headers are actually on Row 2 with Row 1 empty (no way to tell that from the data you posted in Message #1), so this line of code...

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

did not find the actual last column which screwed everything up. Change that line of code to this and then my macro should work correctly for you...

LastCol = Cells(2, Columns.Count).End(xlToLeft).Column

 

[jolivanes]

Loop through Columns and Change Row Values to be of the respective Column As suggested in above thread, you can delete the "lr" line (It is still showing in Post #1 and Post #6) Unless you want to use it at another part of the code.

 

[ShuStar]

Thanks for highlighting Rick - this has now resolved it! Brill!

Jolivanes - thanks for the reminder, will look to remove.

Many thanks all, appreciate it

 

[Peter_SSs]

Using Windows and MS Office 2010 (profile has been updated to reflect accordingly).

Thanks for updating.


From your code & description I gather that your sheet starts off looking like something this.

ShuStar 2020-08-01 1.xlsm
	A	B	C	D	E	F	G
1
2	ID	Name	Count	Banana	Apples	Nectarine	Lemon
3	12345	John	1	Y
4	12345	Sara	4	Y	Y	Y
5	12345	Alex	3	Y	Y		Y
6
Sheet1

If so, here is another macro to consider to do both the concatenation & the "Y" replacements.

Sub Concat_Fruit()
  Dim i As Long
  Dim HdrAddr As String, LastCol As String
  
  Columns(4).Insert
  LastCol = Split(Cells(2, Columns.Count).End(xlToLeft).Address, "$")(1)
  HdrAddr = "E2:" & LastCol & 2
  For i = 3 To Range("A" & Rows.Count).End(xlUp).Row
    Cells(i, 4).Value = Replace(Join(Filter(Evaluate(HdrAddr & "&""|""&E" & i & ":" & LastCol & i), "|Y"), ", "), "|Y", "")
  Next i
  For i = 5 To Columns(LastCol).Column
    Columns(i).Replace "Y", Cells(2, i), xlWhole
  Next i
  Columns(4).AutoFit
End Sub

After the code:

ShuStar 2020-08-01 1.xlsm
	A	B	C	D	E	F	G	H
1
2	ID	Name	Count		Banana	Apples	Nectarine	Lemon
3	12345	John	1	Banana	Banana
4	12345	Sara	4	Banana, Apples, Nectarine	Banana	Apples	Nectarine
5	12345	Alex	3	Banana, Apples, Lemon	Banana	Apples		Lemon
6
Sheet1