Rearranging

[tobeon]

Hello,


I have a table which is formatted like this

A B C
Title Group Count
example 1 5
example 2 3
example 3 8
example2 1 4
example2 2 8
example2 4 10
example2 5 4
example3 2 6
example3 3 12

and I need to change it so that it looks like
Title Group 1 Group 2 Group 3 Group 4 Group 5
example 5 3 8 0 0
example2 4 8 0 10 4
example3 0 6 12 0 0


Any ideas about how I can go about this (there is too much data to this manually)

Thanks very much

 

[djt76010]

Are you familiar with PivotTables? If you create a PivotTable with "Title" as the Row Label and "Group" as the Column Lable that should do the trick.

 

[hiker95]

tobeon,


Sample raw data:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J
1	Title	Group	Count
2	example	1	5
3	example	2	3
4	example	3	8
5	example2	1	4
6	example2	2	8
7	example2	4	10
8	example2	5	4
9	example3	2	6
10	example3	3	12
11
Sheet1

After the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J
1	Title	Group	Count		Title	Group 1	Group 2	Group 3	Group 4	Group 5
2	example	1	5		example	5	3	8	0	0
3	example	2	3		example2	4	8	0	10	4
4	example	3	8		example3	0	6	12	0	0
5	example2	1	4
6	example2	2	8
7	example2	4	10
8	example2	5	4
9	example3	2	6
10	example3	3	12
11
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, 09/27/2011
' http://www.mrexcel.com/forum/showthread.php?t=581673
Dim lr As Long, lc As Long, lc2 As Long, r As Long
Dim b As Long, c As Long, s As Long, e As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Range("A2:C" & lr).Sort Key1:=Range("A2"), order1:=1, Header:=xlNo
Range("A1:A" & lr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, lc + 2), Unique:=True
Range("B1:B" & lr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, lc + 3), Unique:=True
lr = Cells(Rows.Count, lc + 3).End(xlUp).Row
Range(Cells(2, lc + 3), Cells(lr, lc + 3)).Sort Key1:=Cells(2, lc + 3), order1:=xlAscending, Header:=xlNo
Cells(1, lc + 3).Resize(, lr - 1).Value = Application.Transpose(Range(Cells(2, lc + 3), Cells(lr, lc + 3)))
lc2 = Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, lc + 3), Cells(lr, lc + 3)).ClearContents
lr = Cells(Rows.Count, lc + 2).End(xlUp).Row
Range(Cells(2, lc + 3), Cells(lr, lc2)).Value = 0
For r = 2 To lr Step 1
  s = Application.Match(Cells(r, lc + 2), Columns(1), 0)
  e = Application.Match(Cells(r, lc + 2), Columns(1), 1)
  For b = s To e Step 1
    c = 0
    On Error Resume Next
    c = Application.Match(Cells(b, 2), Rows(1), 0)
    On Error GoTo 0
    If c > 0 Then
      Cells(r, c) = Cells(b, 3)
    End If
  Next b
Next r
For c = lc + 3 To lc2 Step 1
  Cells(1, c) = "Group " & Cells(1, c)
Next c
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.


The macro should adjust for more or less than 5 groups.

 

[tobeon]

Thanks very much hiker95, that worked perfectly!

 

[hiker95]

tobeon,

You are very welcome.

Glad I could help.

Thanks for the feedback.

Come back anytime.