Macro to concatenate rows to single cell

ukbulldog001

ukbulldog001

New Member
Joined
Jul 8, 2015
Messages
23
Office Version
  1. 2021
Platform
  1. Windows
Hi Excelites,

Need macro help to concatenate for below table.
Rows value in single cell based on value in column A. example as demonstrated below table.

Book2
ABCDE
1Item CodeVendor NamePo NumberQuantityDate
2EH1D006-00012KINTECH ENTERPRISE4500095498444959
3EH1D006-00012KINTECH ENTERPRISE45000956773045115
4EH1D022-02203-LFAVNET ASIA PTE LTD.4500075723160045102
5EH1D022-02203-LFAVNET ASIA PTE LTD.450007867440044997
6EH1D022-02203-LFAVNET ASIA PTE LTD.450009380540045125
7EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD4500087645600045063
8EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD4500093963600045106
9EH1D022-02208Utech Electronics4500075815400044963
10EH1D022-02208Utech Electronics4500075815400045157
11EH1D022-02209Utech Electronics45000758153600044977
12EH1D022-02209Utech Electronics4500093973400045124
13EH1D022-02211Utech Electronics45000758152000045057
14EH1D022-02217DIGI KEY CORPORATION4500093879100044928
15EH1D022-02219BRADY COMPANY (I) PVT LTD45000938711000045076
16EH1D022-02223Utech Electronics45000758151000045093
17EH1D022-02223EMS Technologies Ltd4500082659145133
18EH1D022-02224Utech Electronics45000758151000045112
19EH1D022-02224Utech Electronics45000825822000044968
20EH1D022-02229Utech Electronics4500082582500045047
Sheet1


and the resulting table should be like...

Book1.xlsx
GHIJK
1Item CodeVendor NamePo NumberQuantityDate
2EH1D006-00012KINTECH ENTERPRISE KINTECH ENTERPRISE4500095498 45000956774 3002-02-2023 08-07-2023
3EH1D022-02203-LFAVNET ASIA PTE LTD. AVNET ASIA PTE LTD. AVNET ASIA PTE LTD.4500075723 4500078674 45000938051600 400 40025-06-2023 12-03-2023 18-07-2023
4EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD TTI ELECTRONICS ASIA PTE LTD4500087645 45000939636000 600017-05-2023 29-06-2023
5EH1D022-02208Utech Electronics Utech Electronics4500075815 45000758154000 400006-02-2023 19-08-2023
6EH1D022-02209Utech Electronics Utech Electronics4500075815 450009397336000 400020-02-2023 17-07-2023
7EH1D022-02211Utech Electronics45000758152000005-11-2023
8EH1D022-02217DIGI KEY CORPORATION4500093879100001-02-2023
9EH1D022-02219BRADY COMPANY (I) PVT LTD45000938711000030-05-2023
10EH1D022-02223Utech Electronics EMS Technologies Ltd4500075815 450008265910000 116-06-2023 26-07-2023
11EH1D022-02224Utech Electronics Utech Electronics4500075815 450008258210000 2000005-07-2023 11-02-2023
12EH1D022-02229Utech Electronics4500082582500005-01-2023
Sheet1


both table in same workbook and sheet.
Column A to E table 1 and resulting table in Column G to K
Concatenate with "enter key", Alt+Enter.

Thanks for the help...
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
Receip.xlsm
ABCDEFGHIJK
1Item CodeVendor NamePo NumberQuantityDateItem CodeVendor NamePo NumberQuantityDate
2EH1D006-00012KINTECH ENTERPRISE4500095498444959EH1D006-00012KINTECH ENTERPRISE KINTECH ENTERPRISE4500095498 45000956774 3044959 45115
3EH1D006-00012KINTECH ENTERPRISE45000956773045115EH1D022-02203-LFAVNET ASIA PTE LTD. AVNET ASIA PTE LTD. AVNET ASIA PTE LTD.4500075723 4500078674 45000938051600 400 40045102 44997 45125
4EH1D022-02203-LFAVNET ASIA PTE LTD.4500075723160045102EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD TTI ELECTRONICS ASIA PTE LTD4500087645 45000939636000 600045063 45106
5EH1D022-02203-LFAVNET ASIA PTE LTD.450007867440044997EH1D022-02208Utech Electronics Utech Electronics4500075815 45000758154000 400044963 45157
6EH1D022-02203-LFAVNET ASIA PTE LTD.450009380540045125EH1D022-02209Utech Electronics Utech Electronics4500075815 450009397336000 400044977 45124
7EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD4500087645600045063EH1D022-02211Utech Electronics45000758152000045057
8EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD4500093963600045106EH1D022-02217DIGI KEY CORPORATION4500093879100044928
9EH1D022-02208Utech Electronics4500075815400044963EH1D022-02219BRADY COMPANY (I) PVT LTD45000938711000045076
10EH1D022-02208Utech Electronics4500075815400045157EH1D022-02223Utech Electronics EMS Technologies Ltd4500075815 450008265910000 145093 45133
11EH1D022-02209Utech Electronics45000758153600044977EH1D022-02224Utech Electronics Utech Electronics4500075815 450008258210000 2000045112 44968
12EH1D022-02209Utech Electronics4500093973400045124EH1D022-02229Utech Electronics4500082582500045047
13EH1D022-02211Utech Electronics45000758152000045057
14EH1D022-02217DIGI KEY CORPORATION4500093879100044928
15EH1D022-02219BRADY COMPANY (I) PVT LTD45000938711000045076
16EH1D022-02223Utech Electronics45000758151000045093
17EH1D022-02223EMS Technologies Ltd4500082659145133
18EH1D022-02224Utech Electronics45000758151000045112
19EH1D022-02224Utech Electronics45000825822000044968
20EH1D022-02229Utech Electronics4500082582500045047
21
Sheet14
Cell Formulas
RangeFormula
G2:G12G2=UNIQUE(A2:A20)
H2:K12H2=TEXTJOIN(" ",,FILTER(B$2:B$20,$A$2:$A$20=$G2))
Dynamic array formulas.



Why Use Macro .. Is it helpful for your query??
 
Last edited:
Upvote 0
Sorry my bad, Column E should be in date format instead of general.
I'm in search of a macro since I'll be sending it to my friends, I'll be using some buttons to execute and make a dedicated file for the purpose...

although the formula works fine with some fine tuning to my requirement, I'm in need of a macro.

Thanks...
 
Upvote 0
Here is with date format. You can Record a macro itself .

Receip.xlsm
ABCDEFGHIJK
1Item CodeVendor NamePo NumberQuantityDateItem CodeVendor NamePo NumberQuantityDate
2EH1D006-00012KINTECH ENTERPRISE450009549842/2/2023EH1D006-00012KINTECH ENTERPRISE KINTECH ENTERPRISE4500095498 45000956774 3002/02/2023 07/08/2023
3EH1D006-00012KINTECH ENTERPRISE4500095677307/8/2023EH1D022-02203-LFAVNET ASIA PTE LTD. AVNET ASIA PTE LTD. AVNET ASIA PTE LTD.4500075723 4500078674 45000938051600 400 40006/25/2023 03/12/2023 07/18/2023
4EH1D022-02203-LFAVNET ASIA PTE LTD.450007572316006/25/2023EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD TTI ELECTRONICS ASIA PTE LTD4500087645 45000939636000 600005/17/2023 06/29/2023
5EH1D022-02203-LFAVNET ASIA PTE LTD.45000786744003/12/2023EH1D022-02208Utech Electronics Utech Electronics4500075815 45000758154000 400002/06/2023 08/19/2023
6EH1D022-02203-LFAVNET ASIA PTE LTD.45000938054007/18/2023EH1D022-02209Utech Electronics Utech Electronics4500075815 450009397336000 400002/20/2023 07/17/2023
7EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD450008764560005/17/2023EH1D022-02211Utech Electronics45000758152000005/11/2023
8EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD450009396360006/29/2023EH1D022-02217DIGI KEY CORPORATION4500093879100001/02/2023
9EH1D022-02208Utech Electronics450007581540002/6/2023EH1D022-02219BRADY COMPANY (I) PVT LTD45000938711000005/30/2023
10EH1D022-02208Utech Electronics450007581540008/19/2023EH1D022-02223Utech Electronics EMS Technologies Ltd4500075815 450008265910000 106/16/2023 07/26/2023
11EH1D022-02209Utech Electronics4500075815360002/20/2023EH1D022-02224Utech Electronics Utech Electronics4500075815 450008258210000 2000007/05/2023 02/11/2023
12EH1D022-02209Utech Electronics450009397340007/17/2023EH1D022-02229Utech Electronics4500082582500005/01/2023
13EH1D022-02211Utech Electronics4500075815200005/11/2023
14EH1D022-02217DIGI KEY CORPORATION450009387910001/2/2023
15EH1D022-02219BRADY COMPANY (I) PVT LTD4500093871100005/30/2023
16EH1D022-02223Utech Electronics4500075815100006/16/2023
Sheet14
Cell Formulas
RangeFormula
G2:G12G2=UNIQUE(A2:A20)
H2:J12H2=TEXTJOIN(" ",,FILTER(B$2:B$20,$A$2:$A$20=$G2))
K2:K12K2=TEXTJOIN(" ", TRUE, IF(G2=$A$2:$A$20,TEXT($E$2:$E$20,"mm/dd/yyyy"),""))
Dynamic array formulas.
 
Upvote 0
ukbulldog001 said:
Hi Excelites,

Need macro help to concatenate for below table.
Rows value in single cell based on value in column A. example as demonstrated below table.

Book2
ABCDE
1Item CodeVendor NamePo NumberQuantityDate
2EH1D006-00012KINTECH ENTERPRISE4500095498444959
3EH1D006-00012KINTECH ENTERPRISE45000956773045115
4EH1D022-02203-LFAVNET ASIA PTE LTD.4500075723160045102
5EH1D022-02203-LFAVNET ASIA PTE LTD.450007867440044997
6EH1D022-02203-LFAVNET ASIA PTE LTD.450009380540045125
7EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD4500087645600045063
8EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD4500093963600045106
9EH1D022-02208Utech Electronics4500075815400044963
10EH1D022-02208Utech Electronics4500075815400045157
11EH1D022-02209Utech Electronics45000758153600044977
12EH1D022-02209Utech Electronics4500093973400045124
13EH1D022-02211Utech Electronics45000758152000045057
14EH1D022-02217DIGI KEY CORPORATION4500093879100044928
15EH1D022-02219BRADY COMPANY (I) PVT LTD45000938711000045076
16EH1D022-02223Utech Electronics45000758151000045093
17EH1D022-02223EMS Technologies Ltd4500082659145133
18EH1D022-02224Utech Electronics45000758151000045112
19EH1D022-02224Utech Electronics45000825822000044968
20EH1D022-02229Utech Electronics4500082582500045047
Sheet1


and the resulting table should be like...

Book1.xlsx
GHIJK
1Item CodeVendor NamePo NumberQuantityDate
2EH1D006-00012KINTECH ENTERPRISE KINTECH ENTERPRISE4500095498 45000956774 3002-02-2023 08-07-2023
3EH1D022-02203-LFAVNET ASIA PTE LTD. AVNET ASIA PTE LTD. AVNET ASIA PTE LTD.4500075723 4500078674 45000938051600 400 40025-06-2023 12-03-2023 18-07-2023
4EH1D022-02204-LFTTI ELECTRONICS ASIA PTE LTD TTI ELECTRONICS ASIA PTE LTD4500087645 45000939636000 600017-05-2023 29-06-2023
5EH1D022-02208Utech Electronics Utech Electronics4500075815 45000758154000 400006-02-2023 19-08-2023
6EH1D022-02209Utech Electronics Utech Electronics4500075815 450009397336000 400020-02-2023 17-07-2023
7EH1D022-02211Utech Electronics45000758152000005-11-2023
8EH1D022-02217DIGI KEY CORPORATION4500093879100001-02-2023
9EH1D022-02219BRADY COMPANY (I) PVT LTD45000938711000030-05-2023
10EH1D022-02223Utech Electronics EMS Technologies Ltd4500075815 450008265910000 116-06-2023 26-07-2023
11EH1D022-02224Utech Electronics Utech Electronics4500075815 450008258210000 2000005-07-2023 11-02-2023
12EH1D022-02229Utech Electronics4500082582500005-01-2023
Sheet1


both table in same workbook and sheet.
Column A to E table 1 and resulting table in Column G to K
Concatenate with "enter key", Alt+Enter.

Thanks for the help...
Click to expand...

This will work irrespective of how many rows in your source table.

I have assumed that the source table is called 'tblVendors'.

It produces a table called 'tblMerged'

Try it on a sheet called 'Vendors' with just the source table called 'tblVendors' and let me know if it works ok.

The sheet and table names can be changed later.

VBA Code: 
Public Sub subCreateAndPopulateTableVersion1()
Dim Ws As Worksheet
Dim tblVendors As Object
Dim tblMerged As Object
Dim i As Integer
Dim ii As Integer
Dim intRows As Integer
Dim arr() As Variant
Dim arrDates() As String
Dim q As String
Dim strDates As String
Dim s As String

    ActiveWorkbook.Save

    Set Ws = Worksheets("Vendors")
    
    Ws.Activate
    
    Set tblVendors = Ws.ListObjects("tblVendors")
    
    ' Delete tblMerged table if it exists.
    On Error Resume Next
    Ws.ListObjects("tblMerged").Delete
    On Error GoTo 0
    
    ' Copy tblVendors table to create template for tblMerged table.
    Ws.Range("tblVendors[#All]").Copy Destination:=Ws.Range("G1")
    Ws.ListObjects(2).Name = "tblMerged"
    Set tblMerged = Ws.ListObjects("tblMerged")
    
    ' Calculate number of unique Vendor Codes.
    intRows = Ws.Evaluate("=ROWS(UNIQUE(tblVendors[Item Code]))")
    
    ' Delete unrequired rows and all data.
    With tblMerged
        For i = .ListRows.Count To intRows + 1 Step -1
            .ListRows(i).Delete
        Next i
        .DataBodyRange.ClearContents
    End With
    
    ' Populate Item Code column with unique values.
    arr = Evaluate("=UNIQUE(tblVendors[Item Code])")
    For i = 1 To intRows
        With tblMerged.ListRows(i)
            .Range(1).Value = arr(i, 1)
        End With
    Next i
        
    q = Chr(34)
    
    ' Apply Filter formulas.
    With tblMerged.ListRows(1)
        .Range(2).Formula = "=TEXTJOIN(CHAR(10),TRUE,FILTER(tblVendors[Vendor Name],tblVendors[Item Code]=[@[Item Code]]))"
        .Range(3).Formula = "=TEXTJOIN(CHAR(10),TRUE,FILTER(tblVendors[Po Number],tblVendors[Item Code]=[@[Item Code]]))"
        .Range(4).Formula = "=TEXTJOIN(CHAR(10),TRUE,FILTER(tblVendors[Quantity],tblVendors[Item Code]=[@[Item Code]]))"
        .Range(5).Formula = "=TEXTJOIN(" & q & "," & q & ",TRUE,FILTER(tblVendors[Date],tblVendors[Item Code]=[@[Item Code]]))"
    End With
    
    ' Convert formula results to values.
    Ws.Range("tblMerged[[Vendor Name]:[Quantity]]").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("G1").Select
    
    ' Wrap and Autofit.
    With tblMerged
        For i = 1 To 4
            .ListColumns(i).Range.wraptext = False
            .ListColumns(i).Range.Columns.AutoFit
            .ListColumns(i).Range.wraptext = True
            .ListColumns(i).Range.Columns.AutoFit
        Next i
    End With
    
    ' Convert date values to formatted dates.
    For i = 1 To intRows
        With tblMerged.ListRows(i)
            arrDates() = Split(.Range(5).Value, ",")
            strDates = ""
            For ii = LBound(arrDates) To UBound(arrDates)
                If strDates = "" Then
                    strDates = Format(arrDates(ii), "dd/mm/yyyy")
                Else
                    strDates = strDates & Chr(10) & Format(arrDates(ii), "dd/mm/yyyy")
                End If
            Next ii
            .Range(5).Value = strDates
        End With
    Next i
    
    ' Wrap and Autofit Date column.
    With tblMerged
        .ListColumns(5).Range.wraptext = True
        .ListColumns(5).Range.Columns.AutoFit
    End With
    
    Ws.Cells.EntireRow.AutoFit
    
    MsgBox "Merged Table Created & Populated", vbOKOnly, "Confirmation"
    
End Sub
 
Upvote 0
Herakles said:
This will work irrespective of how many rows in your source table.

I have assumed that the source table is called 'tblVendors'.

It produces a table called 'tblMerged'

Try it on a sheet called 'Vendors' with just the source table called 'tblVendors' and let me know if it works ok.

The sheet and table names can be changed later.

VBA Code: 
Public Sub subCreateAndPopulateTableVersion1()
Dim Ws As Worksheet
Dim tblVendors As Object
Dim tblMerged As Object
Dim i As Integer
Dim ii As Integer
Dim intRows As Integer
Dim arr() As Variant
Dim arrDates() As String
Dim q As String
Dim strDates As String
Dim s As String

    ActiveWorkbook.Save

    Set Ws = Worksheets("Vendors")
   
    Ws.Activate
   
    Set tblVendors = Ws.ListObjects("tblVendors")
   
    ' Delete tblMerged table if it exists.
    On Error Resume Next
    Ws.ListObjects("tblMerged").Delete
    On Error GoTo 0
   
    ' Copy tblVendors table to create template for tblMerged table.
    Ws.Range("tblVendors[#All]").Copy Destination:=Ws.Range("G1")
    Ws.ListObjects(2).Name = "tblMerged"
    Set tblMerged = Ws.ListObjects("tblMerged")
   
    ' Calculate number of unique Vendor Codes.
    intRows = Ws.Evaluate("=ROWS(UNIQUE(tblVendors[Item Code]))")
   
    ' Delete unrequired rows and all data.
    With tblMerged
        For i = .ListRows.Count To intRows + 1 Step -1
            .ListRows(i).Delete
        Next i
        .DataBodyRange.ClearContents
    End With
   
    ' Populate Item Code column with unique values.
    arr = Evaluate("=UNIQUE(tblVendors[Item Code])")
    For i = 1 To intRows
        With tblMerged.ListRows(i)
            .Range(1).Value = arr(i, 1)
        End With
    Next i
       
    q = Chr(34)
   
    ' Apply Filter formulas.
    With tblMerged.ListRows(1)
        .Range(2).Formula = "=TEXTJOIN(CHAR(10),TRUE,FILTER(tblVendors[Vendor Name],tblVendors[Item Code]=[@[Item Code]]))"
        .Range(3).Formula = "=TEXTJOIN(CHAR(10),TRUE,FILTER(tblVendors[Po Number],tblVendors[Item Code]=[@[Item Code]]))"
        .Range(4).Formula = "=TEXTJOIN(CHAR(10),TRUE,FILTER(tblVendors[Quantity],tblVendors[Item Code]=[@[Item Code]]))"
        .Range(5).Formula = "=TEXTJOIN(" & q & "," & q & ",TRUE,FILTER(tblVendors[Date],tblVendors[Item Code]=[@[Item Code]]))"
    End With
   
    ' Convert formula results to values.
    Ws.Range("tblMerged[[Vendor Name]:[Quantity]]").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("G1").Select
   
    ' Wrap and Autofit.
    With tblMerged
        For i = 1 To 4
            .ListColumns(i).Range.wraptext = False
            .ListColumns(i).Range.Columns.AutoFit
            .ListColumns(i).Range.wraptext = True
            .ListColumns(i).Range.Columns.AutoFit
        Next i
    End With
   
    ' Convert date values to formatted dates.
    For i = 1 To intRows
        With tblMerged.ListRows(i)
            arrDates() = Split(.Range(5).Value, ",")
            strDates = ""
            For ii = LBound(arrDates) To UBound(arrDates)
                If strDates = "" Then
                    strDates = Format(arrDates(ii), "dd/mm/yyyy")
                Else
                    strDates = strDates & Chr(10) & Format(arrDates(ii), "dd/mm/yyyy")
                End If
            Next ii
            .Range(5).Value = strDates
        End With
    Next i
   
    ' Wrap and Autofit Date column.
    With tblMerged
        .ListColumns(5).Range.wraptext = True
        .ListColumns(5).Range.Columns.AutoFit
    End With
   
    Ws.Cells.EntireRow.AutoFit
   
    MsgBox "Merged Table Created & Populated", vbOKOnly, "Confirmation"
   
End Sub
Click to expand...
not working as intended, also has error.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
Get data in different row and summarize in a single cell with comma
Replies
5
Views
377
alansidman
A

Forum statistics

Threads
1,215,077
Messages
6,122,991
Members
449,094
Latest member
masterms

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top