Finding all of the same values in a column and concatenating related row data into one cell

[SianRF]

Hi all

I am fairly new to this and struggling with a number of things but ultimately, I need to be able to find all rows with the same invoice number and then concatenate each invoice description cell into one cell at the end of my data table. So far I have the code below (which, I know, is not much at the moment) and this only identifies the first invoice number and copies the descriptions into separate cells in column J.

Additionally some of the description lines can be blank and for each invoice number there could be a variable number of rows.

I have tried a number of things to get it to loop through the whole of column D to do the same for each invoice number and to concatenate the invoice descriptions into one cell at the end of my data table (see table below) but am failing miserably. I would be grateful for any advice.
Sub FindInvoice()
Set wrk = Worksheets("Template")
Set inRng = Range("D1:D10000")
Set outRng = Range("J2")
' Starting point of data
findVal = Range("A2")
' Loop through rows in the input range / find result then copies
For cntr = 1 To inRng.Rows.Count
If inRng(cntr, 1) = findVal Then
outRng(outCntr + 1, 1) = inRng(cntr, 2)
outCntr = outCntr + 1
End If

Next cntr
End Sub

Inv No Grouped</SPAN>	Customer No.</SPAN>	Customer Name</SPAN>	Invoice No.</SPAN>	Invoice Line Description</SPAN>	Invoice Date</SPAN>	Amount Outstanding</SPAN>	Requested By</SPAN>	Budget Holder	Output column</SPAN>
102477</SPAN>	20873</SPAN>	TORFAEN COUNTY BOROUGH COUNCIL</SPAN>	102477</SPAN>	FAO MRS T - EDUCATION DEPT SPECIAL NEEDS</SPAN>	19-Dec-2005</SPAN>	£94.52</SPAN>	GAIL ELIAS</SPAN>	ALISON STROUD</SPAN>
	20873</SPAN>	TORFAEN COUNTY BOROUGH COUNCIL</SPAN>	102477</SPAN>		19-Dec-2005</SPAN>	£94.52</SPAN>	GAIL ELIAS</SPAN>	ALISON STROUD</SPAN>
	20873</SPAN>	TORFAEN COUNTY BOROUGH COUNCIL</SPAN>	102477</SPAN>	Reimbursement for cost of Speech & Language Therapy to Neil Jones</SPAN>	19-Dec-2005</SPAN>	£94.52</SPAN>	GAIL ELIAS</SPAN>	ALISON STROUD</SPAN>
	20873</SPAN>	TORFAEN COUNTY BOROUGH COUNCIL</SPAN>	102477</SPAN>	4 Hours SLT time in July 2005</SPAN>	19-Dec-2005</SPAN>	£94.52</SPAN>	GAIL ELIAS</SPAN>	ALISON STROUD</SPAN>
	20873</SPAN>	TORFAEN COUNTY BOROUGH COUNCIL</SPAN>	102477</SPAN>	3 Hours SLT time in Sept 2005</SPAN>	19-Dec-2005</SPAN>	£94.52</SPAN>	GAIL ELIAS</SPAN>	ALISON STROUD</SPAN>
103220</SPAN>	20873</SPAN>	TORFAEN COUNTY BOROUGH COUNCIL</SPAN>	103220</SPAN>		16-Jan-2006</SPAN>	£1,608.82</SPAN>	GAIL ELIAS</SPAN>	ALISON STROUD</SPAN>
	20873</SPAN>	TORFAEN COUNTY BOROUGH COUNCIL</SPAN>	103220</SPAN>	Bill for 1/3rd of of the costs of Speech Therapists at the Outreach Service - 3nd quarter 2005/06 as attached</SPAN>	16-Jan-2006</SPAN>	£1,608.82</SPAN>	GAIL ELIAS</SPAN>
	20873</SPAN>	TORFAEN COUNTY BOROUGH COUNCIL</SPAN>	103220</SPAN>	F.A.O. Mr D James - Torfaen Education Department</SPAN>	16-Jan-2006</SPAN>	£1,608.82</SPAN>	GAIL ELIAS</SPAN>
10484</SPAN>	23211</SPAN>	WELSH SCHOOL OF PHARMACY</SPAN>	10484</SPAN>	Refer to Credit Note SCRN/00000032 Newport LHB</SPAN>	26-Nov-2009</SPAN>	-£542.00</SPAN>	ANDREW ASTON</SPAN>
	23211</SPAN>	WELSH SCHOOL OF PHARMACY</SPAN>	10484</SPAN>		26-Nov-2009</SPAN>	-£542.00</SPAN>	ANDREW ASTON</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL></COLGROUP>

 

[hiker95]

SianRF,

I assume that all your Invoice numbers in column D are grouped/sorted per your posted display.

Sample raw data (not all columns are shown in order to fit the MrExcel display area):

Excel 2007
	D	E	J
1	Invoice No.	Invoice Line Description	Output column
2	102477	FAO MRS T - EDUCATION DEPT SPECIAL NEEDS
3	102477
4	102477	Reimbursement for cost of Speech & Language Therapy to Neil Jones
5	102477	4 Hours SLT time in July 2005
6	102477	3 Hours SLT time in Sept 2005
7	103220
8	103220	Bill for 1/3rd of of the costs of Speech Therapists at the Outreach Service - 3nd quarter 2005/06 as attached
9	103220	F.A.O. Mr D James - Torfaen Education Department
10	10484	Refer to Credit Note SCRN/00000032 Newport LHB
11	10484
12
Sheet1

After the macro:

Excel 2007
	D	E	J
1	Invoice No.	Invoice Line Description	Output column
2	102477	FAO MRS T - EDUCATION DEPT SPECIAL NEEDS	FAO MRS T - EDUCATION DEPT SPECIAL NEEDS Reimbursement for cost of Speech & Language Therapy to Neil Jones 4 Hours SLT time in July 2005 3 Hours SLT time in Sept 2005
3	102477
4	102477	Reimbursement for cost of Speech & Language Therapy to Neil Jones
5	102477	4 Hours SLT time in July 2005
6	102477	3 Hours SLT time in Sept 2005
7	103220		Bill for 1/3rd of of the costs of Speech Therapists at the Outreach Service - 3nd quarter 2005/06 as attached F.A.O. Mr D James - Torfaen Education Department
8	103220	Bill for 1/3rd of of the costs of Speech Therapists at the Outreach Service - 3nd quarter 2005/06 as attached
9	103220	F.A.O. Mr D James - Torfaen Education Department
10	10484	Refer to Credit Note SCRN/00000032 Newport LHB	Refer to Credit Note SCRN/00000032 Newport LHB
11	10484
12
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub GetUniquesConcat()
' hiker95, 11/06/2014, ME816473
Dim lr As Long, r As Long, n As Long, cw As Double
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 4).End(xlUp).Row
cw = Columns(5).ColumnWidth
For r = 2 To lr
  n = Application.CountIf(Columns(4), Cells(r, 4).Value)
  Cells(r, 10).Value = Join(Application.Transpose(Range("E" & r & ":E" & r + n - 1)), vbLf)
  r = r + n - 1
Next r
Columns(10).ColumnWidth = cw
Rows(1).Resize(lr).AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetUniquesConcat macro.

 

[SianRF]

Fantastic!! This works absolutely perfectly, thank you so much. I can now add my other bits and bobs to get the whole shebang up and running

 

[hiker95]

SianRF,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.