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

4653

New Member
Joined
Apr 20, 2012
Messages
27
Office Version
  1. 365
Platform
  1. Windows
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:[TABLE="width: 500"]
<tbody>[TR]
[TD]1
[/TD]
[TD]John
[/TD]
[TD]123
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Brad
[/TD]
[TD]456
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]William
[/TD]
[TD]789
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Brian
[/TD]
[TD]987
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Jim
[/TD]
[TD]654
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]I need it to look like this
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]John
[/TD]
[TD]123
[/TD]
[TD]Brad
[/TD]
[TD]456
[/TD]
[TD]William
[/TD]
[TD]789
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Brian
[/TD]
[TD]987
[/TD]
[TD]Jim
[/TD]
[TD]654
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
'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.


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.
 
Upvote 0
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
ABCDEFGHIJK
11John123
21Brad456
31William789
42Brian987
52Jim654
6
Sheet1


After the macro:


Excel 2007
ABCDEFGHIJK
11John1231John123Brad456William789
21Brad4562Brian987Jim654
31William789
42Brian987
52Jim654
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.

Code:
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.
 
Upvote 0
'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.

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!
 
Upvote 0
hiker95, This did sort it but not the way I needed it to. However, thanks for your response.
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
jbeaucaire,

Thanks, now I understand.

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

Thanks to jbeaucaire's input.

Sample raw data:


Excel 2007
ABCDEFG
11John123
21Brad456
31William789
42Brian987
52Jim654
6
Sheet1


And, after the new macro:


Excel 2007
ABCDEFG
11John123Brad456William789
22Brian987Jim654
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).

Code:
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.
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

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