Concatenate Multiple Rows

[spersad]

Hi all:

I have a spreadsheet with 5500 rows. I am looking to join certain rows by a unique identifier. My column layout is as follows:

Account Name Current Investments
foo1 PE
foo1 FoHF
foo1 HF
foo2 HF
foo3 RE
foo3 PE

What I would like for my data upload is:

Account Name Current Investments
foo1 PE, FoHF, HF
foo3 RE, PE

Where the unique identifer = Account Name. Is there a way to do this with the CONCATENATE and IF functions in excel ?


Thanks in advance for the help.


Lenee

 

[hiker95]

spersad,

If you are looking for a VBA Macro solution:


Sample raw data before the macro:

Excel Workbook
	A	B
1	Account Name	Current Investments
2	foo1	PE
3	foo1	FoHF
4	foo1	HF
5	foo2	HF
6	foo3	RE
7	foo3	PE
8
Sheet1

After the macro:

Excel Workbook
	A	B
1	Account Name	Current Investments
2	foo1	PE, FoHF , HF
3	foo2	HF
4	foo3	RE, PE
5
6
7
8
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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 04/17/2011
' http://www.mrexcel.com/forum/showthread.php?t=544187
' Thank you VoG, http://www.mrexcel.com/forum/showthread.php?t=540814
Dim Area As Range, LR As Long, a As Long
Dim At As String, Bt As String
Application.ScreenUpdating = False
At = Range("A1").Value
Bt = Range("B1").Value
Rows(1).Delete
LR = Range("A" & Rows.Count).End(xlUp).Row
For a = LR To 2 Step -1
  If Range("A" & a).Value <> Range("A" & a - 1).Value Then Rows(a).Insert
Next a
Columns("A").Copy Destination:=Range("E1")
Columns("A").Delete
For Each Area In Columns("A").SpecialCells(xlCellTypeConstants).Areas
  If Area.Rows.Count > 1 Then
    Area(1).Offset(, 1).Value = Join(Application.Transpose(Area), ", ")
  Else
    Area(1).Offset(, 1).Value = Area(1).Value
  End If
Next Area
Columns("D").Copy Destination:=Range("A1")
Columns("D").Delete
Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Rows(1).Insert
Range("A1").Value = At
Range("B1").Value = Bt
Columns("A:B").AutoFit
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.

 

[hiker95]

spersad,

Your data must be grouped/sorted before you run the macro.


The above macro will replace the original data with the results.

If you would like to keep the original data, and have the results in different columns, or in a new worksheet, then let me know.

 

[spersad]

Hi Hiker95:

Thanks for the help. I tried it, and it seem to work well. I did leave out one important fact.

I have 22 columns, address info, contact numbers, etc. They are linked to account name. Is there a way to extend the macro to align the entire row when you do the join ? Would it be easier to send you the spreadsheet to explain it better?


Thanks,

Leneee

 

[hiker95]

spersad,

You will generally get much more help (and faster) in this forum if you can post your small samples (what you have and what you expect to achieve) directly in the forum.

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

If you are not able to give us screenshots, see below in my Signature block: You can upload your workbook to Box Net

 

[spersad]

Hi Hiker95,

Thanks for the advice. I did not know to upload. I have done now to Box.net:

http://www.box.net/shared/zkkrlqapo4

Thank you for the help.

Cheers,

Leneee

 

[hiker95]

spersad,


For display purposes I have only shown columns A thru C (of columns A thru V) (sensative information changed).


Sample raw data before the updated macro:

Excel Workbook
	A	B	C
1	Account_Name	Current_Investments	C
2	1794 Com	Hedge Fund	C2
3	1875 Fin	Long-Only Fund	C3
4	1st Glo	Fund of Hedge Funds, Fund of Private Equity Funds	C4
5	2 PM Port	Long-Only Fund	C5
6	21North	Hedge Fund, Private Equity Fund	C6
7	3 Bank	Fund of Hedge Funds	C7
8	3 Bank	Hedge Fund	C8
9	3 Bank	Long-Only Fund	C9
10	3 Degree	Hedge Fund	C10
11
12
13
All (2)

After the updated macro:

Excel Workbook
	A	B	C
1	Account_Name	Current_Investments	C
2	1794 Com	Hedge Fund	C2
3	1875 Fin	Long-Only Fund	C3
4	1st Glo	Fund of Hedge Funds	C4
5	1st Glo	Fund of Private Equity Funds	C4
6	2 PM Port	Long-Only Fund	C5
7	21North	Hedge Fund	C6
8	21North	Private Equity Fund	C6
9	3 Bank	Fund of Hedge Funds	C7
10	3 Bank	Hedge Fund	C8
11	3 Bank	Long-Only Fund	C9
12	3 Degree	Hedge Fund	C10
13
All (2)

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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgDataV2()
' hiker95, 04/19/2011
' http://www.mrexcel.com/forum/showthread.php?t=544187
Dim LR As Long, a As Long
Dim Sp, s As Long
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 2).End(xlUp).Row
For a = LR To 2 Step -1
  If InStr(Cells(a, 2), ",") > 0 Then
    Sp = Split(Cells(a, 2), ", ")
    s = UBound(Sp)
    Range("A" & a + 1 & ":V" & a + 1).Resize(s).Rows.Insert
    Range("A" & a & ":V" & a).Copy Range("A" & a + 1 & ":V" & a + 1).Resize(s)
    Cells(a, 2).Resize(s + 1).Value = Application.Transpose(Sp)
  End If
Next a
Application.ScreenUpdating = True
End Sub

Before you run the macro, save you workbook, Save As, a macro enabled workbook.


Then run the ReorgDataV2 macro.

 

[spersad]

Hi Hiker95:

Thank you for this. I tried the macro and its not joining the rows. Am I doing something wrong? I copied into a test workbook and ran the macro as written.

Before macro:

A B C
1 Account_Name Current_Investments C
2 1794 Com Hedge Fund C2
3 1875 Fin Long-Only Fund C3
4 1st Glo Fund of Hedge Funds C4
5 1st Glo Fund of Private Equity Funds C4
6 2 PM Port Long-Only Fund C5
7 21North Hedge Fund C6
8 21North Private Equity Fund C6
9 3 Bank Fund of Hedge Funds C7
10 3 Bank Hedge Fund C8
11 3 Bank Long-Only Fund C9
12 3 Degree Hedge Fund C10
13

After macro:

A B C
1 Account_Name Current_Investments C
2 1794 Com Hedge Fund C2
3 1875 Fin Long-Only Fund C3
4 1st Glo Fund of Hedge Funds C4
5 1st Glo Fund of Private Equity Funds C4
6 2 PM Port Long-Only Fund C5
7 21North Hedge Fund C6
8 21North Private Equity Fund C6
9 3 Bank Fund of Hedge Funds C7
10 3 Bank Hedge Fund C8
11 3 Bank Long-Only Fund C9
12 3 Degree Hedge Fund C10
13

 

[hiker95]

spersad,

Ooops! My mistake.

Be back soon.

 

[hiker95]

spersad,


If the worksheet name containing the raw data is always All (2), then let me know and I will adjust the macro.


With your raw data already sorted/grouped together per your Box.Net workbook.


Sample raw data in the first worksheet (left most worksheet in your workbook):

Excel Workbook
	A	B	C
1	Account_Name	Current_Investments	Type
2	1794 Commodore Funds	Hedge Fund	C2
3	1875 Finance SA	Long-Only Fund	C3
4	1st Global	Fund of Hedge Funds, Fund of Private Equity Funds	C4
5	2 PM Portfolio Management	Long-Only Fund	C5
6	21North Advisors	Hedge Fund, Private Equity Fund	C6
7	3 Banken Generali Investment-Gesellschaft	Fund of Hedge Funds	C7
8	3 Banken Generali Investment-Gesellschaft	Hedge Fund	C8
9	3 Banken Generali Investment-Gesellschaft	Long-Only Fund	C9
10	3 Degrees Asset Management Pte. Ltd.	Hedge Fund	C10
11	3A Alternative Asset Advisors SA (Syz & Co)	Hedge Fund	C11
12	3A Asia Limited	Hedge Fund	C12
13	47 Degrees North Capital Management	Hedge Fund	C13
14	4finance, Signer Burtscher & Co	Hedge Fund	C14
15	4finance, Signer Burtscher & Co	Long-Only Fund	C15
16	6800 Capital, LLC	Hedge Fund	C16
17	747 Capital	Private Equity Fund	C17
18	A&G Banca Privada	Hedge Fund	C18
19	A&O Services (Netherland)	Fund of Private Equity Funds	C19
20	A.H. Zeppa Family Foundation	Hedge Fund	C20
21	A.M.&C. Finance SA	Fund of Hedge Funds	C21
22	AAL Advisors At Large SA	Fund of Hedge Funds	C22
23	Aargauische Pensionskasse	Fund of Hedge Funds	C23
24	AB Electrolux Pension Fund	Private Equity Fund	C24
25	AB Electrolux Pension Fund	Real Estate Fund	C25
26	Abacus Planning Group, Inc.	Real Estate Fund	C26
27	ABB, Inc.	Fund of Private Equity Funds	C26
28	ABB, Inc.	Hedge Fund	C28
29	ABB, Inc.	Private Equity Fund	C29
30	ABB, Inc.	Real Estate Fund	C30
31	*	*	*
All (2)

After the macro in a new worksheet Results:

Excel Workbook
	A	B	C
1	Account_Name	Current_Investments	Type
2	1794 Commodore Funds	Hedge Fund	C2
3	1875 Finance SA	Long-Only Fund	C3
4	1st Global	Fund of Hedge Funds, Fund of Private Equity Funds	C4
5	2 PM Portfolio Management	Long-Only Fund	C5
6	21North Advisors	Hedge Fund, Private Equity Fund	C6
7	3 Banken Generali Investment-Gesellschaft	Fund of Hedge Funds, Hedge Fund, Long-Only Fund	C7
8	3 Degrees Asset Management Pte. Ltd.	Hedge Fund	C10
9	3A Alternative Asset Advisors SA (Syz & Co)	Hedge Fund	C11
10	3A Asia Limited	Hedge Fund	C12
11	47 Degrees North Capital Management	Hedge Fund	C13
12	4finance, Signer Burtscher & Co	Hedge Fund, Long-Only Fund	C14
13	6800 Capital, LLC	Hedge Fund	C16
14	747 Capital	Private Equity Fund	C17
15	A&G Banca Privada	Hedge Fund	C18
16	A&O Services (Netherland)	Fund of Private Equity Funds	C19
17	A.H. Zeppa Family Foundation	Hedge Fund	C20
18	A.M.&C. Finance SA	Fund of Hedge Funds	C21
19	AAL Advisors At Large SA	Fund of Hedge Funds	C22
20	Aargauische Pensionskasse	Fund of Hedge Funds	C23
21	AB Electrolux Pension Fund	Private Equity Fund, Real Estate Fund	C24
22	Abacus Planning Group, Inc.	Real Estate Fund	C26
23	ABB, Inc.	Fund of Private Equity Funds, Hedge Fund, Private Equity Fund, Real Estate Fund	C26
24	*	*	*
Results

Option Explicit
Sub ReorgDataV3()
' hiker95, 04/19/2011
' http://www.mrexcel.com/forum/showthread.php?t=544187
Dim w1 As Worksheet, wR As Worksheet
Dim LR As Long, a As Long, aa As Long, SR As Long, ER As Long, H As String
Application.ScreenUpdating = False
Set w1 = Worksheets(1)
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
w1.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wR.Columns(1), Unique:=True
wR.Range("B1:V1").Value = w1.Range("B1:V1").Value
LR = wR.Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To LR Step 1
  SR = Application.Match(wR.Cells(a, 1), w1.Columns(1), 0)
  ER = Application.Match(wR.Cells(a, 1), w1.Columns(1), 1)
  H = ""
  w1.Rows(SR).Copy wR.Rows(a)
  For aa = SR To ER Step 1
    H = H & w1.Cells(aa, 2) & ", "
  Next aa
  If Right(H, 2) = ", " Then H = Left(H, Len(H) - 2)
  wR.Cells(a, 2) = H
Next a
wR.Columns("A:B").AutoFit
wR.Activate
Application.ScreenUpdating = True
End Sub

Before you run the macro, save your workbook, Save As, a macro enabled workbook.


Then run the ReorgDataV3 macro.