Combine multiple rows that have the same id into one row with the moved data in separate cells

[4653]

I have a spreadsheet where in column A each row has an id assigned to particular companies. Each company may have 1 or more contacts with all of the contact info for the personnel listed in their respective row. If it matters, the number of contacts per company vary (could be up to 15) and personnel contact info extends out to column AQ. What I'm trying to figure out is how to take all of the matching id's and move all of the contact info for each respective personnel for the company to a single row and separate cells for each piece of information. If the company id has to move with the info that is fine as I can just delete that column for each occurrence after the move. Any help would be greatly appreciated. Basically it currently looks like this:

1	John	123				
1	Brad	456
1	William	789
2	Brian	987
2	Jim	654
	I need it to look like this
1	John	123	Brad	456	William	789
2	Brian	987	Jim	654

<tbody>
</tbody>

 

[jbeaucaire]

'COLUMNS TO ROWS
Here's a macro for merging columns of data to one row matching for column A. There's a sample workbook too you could drop your data into and test it out.

Columns to Rows - Part 2​

I just ran the "Consolidate" macro found in that section on a data set as you've presented above and it does exactly what you want with no editing. It would be best if row1 of your data had titles for the table.

 

[hiker95]

4653,

With you raw data beginning in cell A1 (per your text display), and, sorted/grouped by the values in column A:

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K
1	1	John	123
2	1	Brad	456
3	1	William	789
4	2	Brian	987
5	2	Jim	654
6
Sheet1

After the macro:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K
1	1	John	123		1	John	123	Brad	456	William	789
2	1	Brad	456		2	Brian	987	Jim	654
3	1	William	789
4	2	Brian	987
5	2	Jim	654
6
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.

Option Explicit
Sub ReorgData()
' hiker95, 02/15/2014, ME758017
Dim r As Long, lr As Long, rr As Long, n As Long, nr As Long, sc As Long, nc As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
nr = 0: sc = 5
For r = 1 To lr
  n = Application.CountIf(Columns(1), Cells(r, 1).Value)
  nr = nr + 1: nc = sc
  If n = 1 Then
    Cells(nr, nc).Resize(, 3).Value = Cells(r, 1).Resize(, 3).Value
  ElseIf n > 1 Then
    Cells(nr, nc).Resize(, 3).Value = Cells(r, 1).Resize(, 3).Value
    For rr = r + 1 To r + n - 1
      nc = Cells(nr, Columns.Count).End(xlToLeft).Column + 1
      Cells(nr, nc).Resize(, 2).Value = Cells(rr, 2).Resize(, 2).Value
    Next rr
  End If
  r = r + n - 1
Next r
Columns.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 ReorgData macro.

 

[4653]

'COLUMNS TO ROWS
Here's a macro for merging columns of data to one row matching for column A. There's a sample workbook too you could drop your data into and test it out.

Columns to Rows - Part 2​

I just ran the "Consolidate" macro found in that section on a data set as you've presented above and it does exactly what you want with no editing. It would be best if row1 of your data had titles for the table.

jbeaucaire, It worked perfectly. Thanks a million!

 

[4653]

hiker95, This did sort it but not the way I needed it to. However, thanks for your response.

 

[hiker95]

4653,

Thanks for the feedback.

This did sort it but not the way I needed it to.

Based on your text display, and, my screenshots, my macro did what you requested.

If my macro did not work correctly, then, can we see your workbook/worksheet(s)?

You can upload your workbook (with before and after worksheets) to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[jbeaucaire]

Hiker, I think he merely wanted the original data reformatted, which is what my macro does by default, versus creating a second sent of data off to the right as yours does. In truth, based on your pictures, yes, your macro works fine, too.

 

[hiker95]

jbeaucaire,

Thanks, now I understand.

I really like your web site, and, have used many of your macros in helping others.

 

[hiker95]

4653,

Thanks to jbeaucaire's input.

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G
1	1	John	123
2	1	Brad	456
3	1	William	789
4	2	Brian	987
5	2	Jim	654
6
Sheet1

And, after the new macro:

Excel 2007
	A	B	C	D	E	F	G
1	1	John	123	Brad	456	William	789
2	2	Brian	987	Jim	654
3
4
5
6
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).

Option Explicit
Sub ReorgDataV2()
' hiker95, 02/16/2014, ME758017
Dim r As Long, lr As Long, n As Long, rr As Long, nc As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 1 To lr
  n = Application.CountIf(Columns(1), Cells(r, 1).Value)
  If n > 1 Then
    For rr = r + 1 To r + n - 1
      nc = Cells(r, Columns.Count).End(xlToLeft).Column + 1
      Cells(r, nc).Resize(, 2).Value = Cells(rr, 2).Resize(, 2).Value
      Cells(rr, 1).Resize(, 3).ClearContents
    Next rr
  End If
  r = r + n - 1
Next r
On Error Resume Next
Range("A1:A" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Columns.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 ReorgDataV2 macro.

 

[jbeaucaire]

jbeaucaire,

Thanks, now I understand.

I really like your web site, and, have used many of your macros in helping others.

Awesome, that's what it's for and great to hear when it's being useful. Cheers.