VBA Concatenate Rows

ShuStar

Board Regular
Joined
Sep 9, 2015
Messages
77
Office Version
2010
Platform
Windows
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)


VBA Code:
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:
IDNameCountBananaApplesNectarineLemon...to nColumn
12345John1Banana
12345Sara4BananaApplesNectarine...to nColumn
12345Alex3BananaApplesLemon...to nColumn
...to nRow##################


Would want adapt above code to Concatenated the rows: (note new Concatenated column added):
IDNameCountConcatenatedBananaApplesNectarineLemon...to nColumn
12345John1Banana, ApplesBanana
12345Sara4Banana, Apples, NectarineBananaApplesNectarine...to nColumn
12345Alex4Banana, Apples, LemonBananaApplesLemon...to nColumn
...to nRow##################



Thanks inadvance Gurus, appreciate the help.
 

Some videos you may like

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,043
Office Version
2010
Platform
Windows
Give this macro a try...
VBA Code:
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
45,232
Office Version
365
Platform
Windows
@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

Board Regular
Joined
Sep 9, 2015
Messages
77
Office Version
2010
Platform
Windows
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:

IDNameCountConcatenated - ID Name and CountBananaApplesNectarineLemon...to nColumn
12345John112345, John, 1Banana
12345Sara412345, Sara, 4BananaApplesNectarine...to nColumn
12345Alex412345, Alex, 4BananaApplesLemon...to nColumn
...to nRow##################



But need it to do as below if possible:

IDNameCountConcatenatedBananaApplesNectarineLemon...to nColumn
12345John1BananaBanana
12345Sara4Banana, Apples, NectarineBananaApplesNectarine...to nColumn
12345Alex4Banana, Apples, LemonBananaApplesLemon...to nColumn
...to nRow##################
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,043
Office Version
2010
Platform
Windows
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

Board Regular
Joined
Sep 9, 2015
Messages
77
Office Version
2010
Platform
Windows
Rick - not sure whats happening. Below is the code i am using. Image is the results when these are executed

1596303925833.png






VBA Code:
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

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,043
Office Version
2010
Platform
Windows
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
 

ShuStar

Board Regular
Joined
Sep 9, 2015
Messages
77
Office Version
2010
Platform
Windows
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
45,232
Office Version
365
Platform
Windows
Using Windows and MS Office 2010 (profile has been updated to reflect accordingly).
Thanks for updating. (y)


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

ShuStar 2020-08-01 1.xlsm
ABCDEFG
1
2IDNameCountBananaApplesNectarineLemon
312345John1Y
412345Sara4YYY
512345Alex3YYY
6
Sheet1



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

VBA Code:
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
ABCDEFGH
1
2IDNameCountBananaApplesNectarineLemon
312345John1BananaBanana
412345Sara4Banana, Apples, NectarineBananaApplesNectarine
512345Alex3Banana, Apples, LemonBananaApplesLemon
6
Sheet1
 

Watch MrExcel Video

Forum statistics

Threads
1,102,561
Messages
5,487,567
Members
407,605
Latest member
PACULA

This Week's Hot Topics

Top