Transpose unsorted items

[fosiza]

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.

Thanks for reading, please share me your knowledge.

 

[azumi]

Please find this link Im share the example based on your table, using array formula (means when applied you need to press CTRL-SHIFT-ENTER button together, ENTER alone will not works)

https://www.dropbox.com/s/5gj6ze98w2qgo63/Sample FIle.xlsx?dl=0

 

[snb_]

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

 

[fosiza]

Please find this link Im share the example based on your table, using array formula (means when applied you need to press CTRL-SHIFT-ENTER button together, ENTER alone will not works)

https://www.dropbox.com/s/5gj6ze98w2qgo63/Sample FIle.xlsx?dl=0

I cant access the dropbox

 

[hiker95]

azumi,

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

Access to this link has been disabled. Please ask the owner of the shared link to send a new link to access the file or the folder.


You can upload your workbook to Box Net,

sensitive data changed

mark the workbook for sharing

and provide us with a link to your workbook.

 

[hiker95]

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
	A	B	C	D	E	F	G	H	I
1	TID	Person	Type	Name
2	1	Andy	F	Orange
3	2	Andy	M	Beef
4	3	Andy	V	Carrot
5	4	Andy	V	Spinach
6	5	Bobby	M	Ham
7	6	Bobby	F	Apple
8	7	Bobby	V	Carrot
9
Sheet1

After the macro:

Excel 2007
	A	B	C	D	E	F	G	H	I
1	TID	Person	Type	Name		Person	F	M	V
2	1	Andy	F	Orange		Andy	Orange	Beef	Carrot
3	2	Andy	M	Beef		Bobby	Apple	Ham	Carrot
4	3	Andy	V	Carrot
5	4	Andy	V	Spinach
6	5	Bobby	M	Ham
7	6	Bobby	F	Apple
8	7	Bobby	V	Carrot
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
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.

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.

 

[hiker95]

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]

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

 

[fosiza]

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

	A	B	C	D	E	F	G	H	I
1	TID	Person	Type	Name
2	1	Andy	F	Orange
3	2	Andy	M	Beef
4	3	Andy	V	Carrot
5	4	Andy	V	Spinach
6	5	Bobby	M	Ham
7	6	Bobby	F	Apple
8	7	Bobby	V	Carrot
9

<tbody>
</tbody>

Sheet1​

After the macro:

Excel 2007

	A	B	C	D	E	F	G	H	I
1	TID	Person	Type	Name		Person	F	M	V
2	1	Andy	F	Orange		Andy	Orange	Beef	Carrot
3	2	Andy	M	Beef		Bobby	Apple	Ham	Carrot
4	3	Andy	V	Carrot
5	4	Andy	V	Spinach
6	5	Bobby	M	Ham
7	6	Bobby	F	Apple
8	7	Bobby	V	Carrot
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
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.

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

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

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

 

[hiker95]

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.

Will be back later with comments in the code to help you understand it.