# Transpose unsorted items

#### fosiza

##### New Member
So lets say that I have a table like this..

 TID Person Type Name 1 Andy F Orange 2 Andy M Beef 3 Andy V Carrot 4 Andy V Spinach 5 Bobby M Ham 6 Bobby F Apple 7 Bobby V Carrot

<tbody>
</tbody>

I want to transpose it so that it will be sorted according to the Type, I want it to look like so

 Person F M V Andy Orange Beef Carrot Bobby Apple Ham Carrot

<tbody>
</tbody>

How can I manage to do this? Oh, and I'll also point some stuff in case you guys missed it:
1. The Types have no particular order, if you notice Andy's, the order is F M V V, but Bobby's is M F V.
2. Multiple instances of Type may occur, just like in Andy's case, notice the double V. But even so, I want it so that the only V that counts is the first one, thats why in the transposed table, the V is Carrot, because the Carrot occurred first (the Spinach is ignored).

I dont know if I ask too much, but even just the gist of the solution would be very helpful for me. The main point of my question is to ask how can I transpose such unsorted items, whilst paying attention to the 1st point. The 2nd point is important too, but I can wait or ask later if you guys dont feel like answering.

### Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the \$ sign).
Code:
``````Sub M_snb()
sn = Cells(1).CurrentRegion
ReDim sp(3)

With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
sq = .Item(sn(j, 2))
If IsEmpty(sq) Then sq = sp
If sq(InStr("FMV", sn(j, 3))) = "" Then sq(InStr("FMV", sn(j, 3))) = sn(j, 4)
sq(0) = sn(j, 2)
.Item(sn(j, 2)) = sq
Next

Cells(10, 1).Resize(.Count, 4) = Application.Index(.items, 0, 0)
End With
End Sub``````

azumi,

When I try to access your link, I get the following message:

sensitive data changed

mark the workbook for sharing

fosiza,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?

With our raw data sorted/grouped per your text display:

Sample raw data:

Excel 2007
ABCDEFGHI
1TIDPersonTypeName
21AndyFOrange
32AndyMBeef
43AndyVCarrot
54AndyVSpinach
65BobbyMHam
76BobbyFApple
87BobbyVCarrot
9
Sheet1

After the macro:

Excel 2007
ABCDEFGHI
1TIDPersonTypeNamePersonFMV
21AndyFOrangeAndyOrangeBeefCarrot
32AndyMBeefBobbyAppleHamCarrot
43AndyVCarrot
54AndyVSpinach
65BobbyMHam
76BobbyFApple
87BobbyVCarrot
9
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
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:
``````Sub ReorgData()
' hiker95, 09/01/2014, ME802453
Dim r As Long, lr As Long, rr As Long, n As Long, nlr As Long
Dim o As Variant, j As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
nlr = CountUnique(Range("B2:B" & lr))
ReDim o(1 To nlr, 1 To 4)
For r = 2 To lr
n = Application.CountIf(Columns(2), Cells(r, 2).Value)
If n = 1 Then
j = j + 1
o(j, 1) = Cells(r, 2)
If Cells(r, 3) = "F" Then
o(j, 2) = Cells(r, 3)
ElseIf Cells(r, 3) = "M" Then
o(j, 3) = Cells(r, 3)
ElseIf Cells(r, 3) = "V" And o(j, 4) = "" Then
o(j, 4) = Cells(r, 3)
End If
ElseIf n > 1 Then
j = j + 1
o(j, 1) = Cells(r, 2)
For rr = r To r + n - 1
If Cells(rr, 3) = "F" Then
o(j, 2) = Cells(rr, 4)
ElseIf Cells(rr, 3) = "M" Then
o(j, 3) = Cells(rr, 4)
ElseIf Cells(rr, 3) = "V" And o(j, 4) = "" Then
o(j, 4) = Cells(rr, 4)
End If
Next rr
End If
r = r + n - 1
Next r
Columns("F:I").ClearContents
With Cells(1, 6).Resize(, 4)
.Value = Array("Person", "F", "M", "V")
.Font.Bold = True
End With
Range("F2").Resize(nlr, 4).Value = o
Columns("F:I").AutoFit
Application.ScreenUpdating = True
End Sub
Function CountUnique(ByVal Rng As Range) As Long
' Juan Pablo González, MrExcel MVP, 05/09/2003
' http://www.mrexcel.com/forum/excel-questions/48385-need-count-unique-items-column-visual-basic-applications.html
Dim St As String
Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
St = "'" & Rng.Parent.Name & "'!" & Rng.Address(False, False)
CountUnique = Evaluate("SUM(IF(LEN(" & St & "),1/COUNTIF(" & St & "," & St & ")))")
End Function``````

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.

fosiza,

I see that you have rated a response to your thread with 5 Stars, but, there was no comment as to which response you finally went with.

Did you even try my macro?

fosiza,

I see that you have rated a response to your thread with 5 Stars, but, there was no comment as to which response you finally went with.

Did you even try my macro?

First of all, thank you very very much for your answer, I did not expect such detailed answer.

Secondly, I havent rated anything since I dont even know how to rate a response, so I have no idea what rate and response youre referring about.

Again, thank you so much for the answer, Ill try it immediately

EDIT: okay, I found out about the rating system, but Ive never rated this thread. By the way, im using ms excel 2010 and im using a PC

Last edited:
fosiza,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?

With our raw data sorted/grouped per your text display:

Sample raw data:

Excel 2007
ABCDEFGHI
1TIDPersonTypeName
21AndyFOrange
32AndyMBeef
43AndyVCarrot
54AndyVSpinach
65BobbyMHam
76BobbyFApple
87BobbyVCarrot
9

<tbody>
</tbody>
Sheet1

After the macro:

Excel 2007
ABCDEFGHI
1TIDPersonTypeNamePersonFMV
21AndyFOrangeAndyOrangeBeefCarrot
32AndyMBeefBobbyAppleHamCarrot
43AndyVCarrot
54AndyVSpinach
65BobbyMHam
76BobbyFApple
87BobbyVCarrot
9

<tbody>
</tbody>
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
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.

Rich (BB code):
``````Sub ReorgData()
' hiker95, 09/01/2014, ME802453
Dim r As Long, lr As Long, rr As Long, n As Long, nlr As Long
Dim o As Variant, j As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
nlr = CountUnique(Range("B2:B" & lr))
ReDim o(1 To nlr, 1 To 4)
For r = 2 To lr
n = Application.CountIf(Columns(2), Cells(r, 2).Value)
If n = 1 Then
j = j + 1
o(j, 1) = Cells(r, 2)
If Cells(r, 3) = "F" Then
o(j, 2) = Cells(r, 3)
ElseIf Cells(r, 3) = "M" Then
o(j, 3) = Cells(r, 3)
ElseIf Cells(r, 3) = "V" And o(j, 4) = "" Then
o(j, 4) = Cells(r, 3)
End If
ElseIf n > 1 Then
j = j + 1
o(j, 1) = Cells(r, 2)
For rr = r To r + n - 1
If Cells(rr, 3) = "F" Then
o(j, 2) = Cells(rr, 4)
ElseIf Cells(rr, 3) = "M" Then
o(j, 3) = Cells(rr, 4)
ElseIf Cells(rr, 3) = "V" And o(j, 4) = "" Then
o(j, 4) = Cells(rr, 4)
End If
Next rr
End If
r = r + n - 1
Next r
Columns("F:I").ClearContents
With Cells(1, 6).Resize(, 4)
.Value = Array("Person", "F", "M", "V")
.Font.Bold = True
End With
Range("F2").Resize(nlr, 4).Value = o
Columns("F:I").AutoFit
Application.ScreenUpdating = True
End Sub
Function CountUnique(ByVal Rng As Range) As Long
' Juan Pablo González, MrExcel MVP, 05/09/2003
' http://www.mrexcel.com/forum/excel-questions/48385-need-count-unique-items-column-visual-basic-applications.html
Dim St As String
Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
St = "'" & Rng.Parent.Name & "'!" & Rng.Address(False, False)
CountUnique = Evaluate("SUM(IF(LEN(" & St & "),1/COUNTIF(" & St & "," & St & ")))")
End Function``````

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.

I cant thank you enough for this answer, it works like a charm.

If you dont mind, I want to know more about macro and this particular solution, itd be great if I can understand how to make the code instead of just using it hehe, and of course since you seemed very knowledgeable in this.

So, lets say I want to add more Type, at TID 4, the Type is changed to X and the Name is Brick, so it would be: 4 Andy X Brick. So at the second sheet, instead of just F M V, itd be F M V X

What code should I add? Of course I should add something in here
Code:
``````For r = 2 To lr
n = Application.CountIf(Columns(2), Cells(r, 2).Value)
If n = 1 Then
j = j + 1
o(j, 1) = Cells(r, 2)
If Cells(r, 3) = "F" Then
o(j, 2) = Cells(r, 3)
ElseIf Cells(r, 3) = "M" Then
o(j, 3) = Cells(r, 3)
ElseIf Cells(r, 3) = "V" And o(j, 4) = "" Then
o(j, 4) = Cells(r, 3)
////////////////////HERE//////////////////////
End If
ElseIf n > 1 Then
j = j + 1
o(j, 1) = Cells(r, 2)
For rr = r To r + n - 1
If Cells(rr, 3) = "F" Then
o(j, 2) = Cells(rr, 4)
ElseIf Cells(rr, 3) = "M" Then
o(j, 3) = Cells(rr, 4)
ElseIf Cells(rr, 3) = "V" And o(j, 4) = "" Then
o(j, 4) = Cells(rr, 4)
////////////////////HERE//////////////////////
End If
Next rr
End If``````
and alter this line

Code:
``````[COLOR=#574123][I]With Cells(1, 6).Resize(, 4)
[/I][/COLOR][COLOR=#574123][I]  .Value = Array("Person", "F", "M", "V")[/I][/COLOR]``````

But I feel like I have to add something else. I code but Ive never code vba so Im not really familiar with the functions, just a brief explanation or an example how to detect if I have a Type then Im sure that I would understand.

Again, thank you very much for your answer, if this follow up question seemed too much or rather annoying to you, feel free to ignore it.

fosiza,

First of all, thank you very very much for your answer, I did not expect such detailed answer.

I cant thank you enough for this answer, it works like a charm.

Thanks for the feedback.

You are very welcome. Glad I could help.

If you dont mind, I want to know more about macro and this particular solution, itd be great if I can understand how to make the code instead of just using it hehe, and of course since you seemed very knowledgeable in this.

Replies
2
Views
541
Replies
1
Views
188
Replies
1
Views
239
Replies
1
Views
471
Replies
3
Views
219

1,219,578
Messages
6,149,098
Members
450,859
Latest member
njaitley

### 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.

### Which adblocker are you using?

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

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