Transpose unsorted items

[fosiza]

So lets say that I have a table like this..

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]TID[/TD]
[TD]Person[/TD]
[TD]Type[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Andy[/TD]
[TD]F[/TD]
[TD]Orange[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Andy[/TD]
[TD]M[/TD]
[TD]Beef[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Andy[/TD]
[TD]V[/TD]
[TD]Carrot[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Andy[/TD]
[TD]V[/TD]
[TD]Spinach[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Bobby[/TD]
[TD]M[/TD]
[TD]Ham[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Bobby[/TD]
[TD]F[/TD]
[TD]Apple[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]Bobby[/TD]
[TD]V[/TD]
[TD]Carrot[/TD]
[/TR]
</tbody>[/TABLE]


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

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Person[/TD]
[TD]F[/TD]
[TD]M[/TD]
[TD]V[/TD]
[/TR]
[TR]
[TD]Andy[/TD]
[TD]Orange[/TD]
[TD]Beef[/TD]
[TD]Carrot[/TD]
[/TR]
[TR]
[TD]Bobby[/TD]
[TD]Apple[/TD]
[TD]Ham[/TD]
[TD]Carrot[/TD]
[/TR]
</tbody>[/TABLE]

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.

 

[fosiza]

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

Thank you very much, thats even better

 

[hiker95]

fosiza,

See the comment lines beginning with the ' character (hope this helps):

Sub ReorgData()
' hiker95, 09/01/2014, ME802453



' it is a good programming practice to define all your variabls
'   if there ever was a problem in the code, a programmer would
'   be able to understand what is going on, and, probably
'   fix the code to work correctly



'   r is a loop counter
'              lr is used to find the last used row in column A
'                          rr is a loop counter for each groop of cells
'                          in column B
'                                      n counts the number of cells/rows in the group
'                                                 nlr gets the number of rows to be used
'                                                 in the o array
Dim r As Long, lr As Long, rr As Long, n As Long, nlr As Long



'   o is the output array, and, a Variant array can hold different types of data
'                 j is the loop counter for the o array rows
Dim o As Variant, j As Long



' turn off screen updating usually makes macros run faster
Application.ScreenUpdating = False



'  find the last used row in colum 1 = A
lr = Cells(Rows.Count, 1).End(xlUp).Row



'  nlr gets the number of unique rows to be used in the o array
'     from the
'     CountUnique function
'                 for Range("B2:B" & lr)
nlr = CountUnique(Range("B2:B" & lr))



'  dimension the o array
'       1 to nlr = 2 for the number of rows needed
'                 1 to 4 for the number of columns needed
ReDim o(1 To nlr, 1 To 4)



'  lets loop thru the raw data beginning in row 2
For r = 2 To lr


' lets just do for "Andy"
' n will calculate how many "Andy's" there are = 4
  n = Application.CountIf(Columns(2), Cells(r, 2).Value)
  
  
  
' if there was only 1, then the following code would only
'   process one row of raw data
  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
  
  
  
' if n > 1 then process the rows in the group for "Andy"
  ElseIf n > 1 Then



'   add one to the j row counter for the o array
'   j has not been set to a number, so by default = 0
'   j + j + 1 = 1
    j = j + 1


'   write to o(j,1) what is in Cells(r,2) = "B2"
'   o(j, 1) = "Andy"
    o(j, 1) = Cells(r, 2)
    
    

'   loop thru the rows in the group "Andy"
'   for column C = Type = F is for "Orange", M is for "Beef", V os for "Carrot"
'       rr = row 2
    For rr = r To r + n - 1



'     If Cells(rr, 3) = "C2", = "F", then
      If Cells(rr, 3) = "F" Then



'       o(j, 2) = Cells(rr, 4) = "Orange"
        o(j, 2) = Cells(rr, 4)



'     ElseIf Cells(rr, 3) = "M"
      ElseIf Cells(rr, 3) = "M" Then
        o(j, 3) = Cells(rr, 4)



'     process the first "V" in the group
'     if the output array item, o(j, 4) is blank/empty, and, rr = row 4
      ElseIf Cells(rr, 3) = "V" And o(j, 4) = "" Then



'       o(j, 4) = "Carrot"
        o(j, 4) = Cells(rr, 4)
      End If



'   loop
    Next rr
  End If



  'loop to the next group
  r = r + n - 1
Next r



' clear the contents of Columns F, thru, Columns "I"
Columns("F:I").ClearContents



' write the titles to cells F1, G1, H1, I1
' and, make the text BOLD
With Cells(1, 6).Resize(, 4)
  .Value = Array("Person", "F", "M", "V")
  .Font.Bold = True
End With



' write the o array to Range("F2:I3")
Range("F2").Resize(nlr, 4).Value = o



' autofit the column widths
Columns("F:I").AutoFit



' turn screen updating back on
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

 

[azumi]

Ooops sorry change it now:

https://simpan.ugm.ac.id/public.php?service=files&t=a6e67ba899fbca40625a4ee9a9691a12

with array formula

 

[fosiza]

fosiza,

See the comment lines beginning with the ' character (hope this helps):

How can I thank more than just by saying 'thank you'? I dont think just a simple 'thank you very much' would be enough.

Thank you very very (very) much for your help, I mean it, this is more than helpful.

Ooops sorry change it now:

https://simpan.ugm.ac.id/public.php?service=files&t=a6e67ba899fbca40625a4ee9a9691a12

with array formula

Thank you for the solution, its very interesting to see a different approach.

 

[hiker95]

fosiza,

Thanks for the feedback.

You are very welcome. Glad we could help.

And, come back anytime.

 

[johnmpl]

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

Nobody said something about the GREAT solution for snb. That's really brilliant and faster that another solutions! Blessings!

 

[fosiza]

Nobody said something about the GREAT solution for snb. That's really brilliant and faster that another solutions! Blessings!

I am very sorry. First of, I dont really know how to apply vb codes to excel, so when I first saw that snb's solution, I just automatically ignored it since I didnt really understand it. hiker95 on the other hand, provide a thorough explanation, from how to apply and run the code, so I just assume that this must be the best answer there is. Plus, he also gave me a complete explanation about his codes, and because of that I, thankfully, now have understand more about the visual basic language.

I have to admit that I do have forgotten about snb's solution. But now that you mentioned it, and since now I can actually understand what the codes means, I have to say it is a brilliant and faster solution. Thank you