Transpose unsorted items

F

fosiza

New Member
Joined
Sep 1, 2014
Messages
11
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.
 
Sort by date Sort by votes
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
 
Upvote 0
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.
 
Upvote 0
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
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: 
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.
 
Upvote 0
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?
 
Upvote 0
hiker95 said:
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?
Click to expand...

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:
Upvote 0
hiker95 said:
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

<tbody>
[TD="align: center"]1[/TD]
[TD="bgcolor: #FFFFFF"]TID[/TD]
[TD="bgcolor: #FFFFFF"]Person[/TD]
[TD="bgcolor: #FFFFFF"]Type[/TD]
[TD="bgcolor: #FFFFFF"]Name[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]2[/TD]
[TD="bgcolor: #FFFFFF, align: right"]1[/TD]
[TD="bgcolor: #FFFFFF"]Andy[/TD]
[TD="bgcolor: #FFFFFF"]F[/TD]
[TD="bgcolor: #FFFFFF"]Orange[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: #FFFFFF, align: right"]2[/TD]
[TD="bgcolor: #FFFFFF"]Andy[/TD]
[TD="bgcolor: #FFFFFF"]M[/TD]
[TD="bgcolor: #FFFFFF"]Beef[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: #FFFFFF, align: right"]3[/TD]
[TD="bgcolor: #FFFFFF"]Andy[/TD]
[TD="bgcolor: #FFFFFF"]V[/TD]
[TD="bgcolor: #FFFFFF"]Carrot[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="bgcolor: #FFFFFF, align: right"]4[/TD]
[TD="bgcolor: #FFFFFF"]Andy[/TD]
[TD="bgcolor: #FFFFFF"]V[/TD]
[TD="bgcolor: #FFFFFF"]Spinach[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="bgcolor: #FFFFFF, align: right"]5[/TD]
[TD="bgcolor: #FFFFFF"]Bobby[/TD]
[TD="bgcolor: #FFFFFF"]M[/TD]
[TD="bgcolor: #FFFFFF"]Ham[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="bgcolor: #FFFFFF, align: right"]6[/TD]
[TD="bgcolor: #FFFFFF"]Bobby[/TD]
[TD="bgcolor: #FFFFFF"]F[/TD]
[TD="bgcolor: #FFFFFF"]Apple[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="bgcolor: #FFFFFF, align: right"]7[/TD]
[TD="bgcolor: #FFFFFF"]Bobby[/TD]
[TD="bgcolor: #FFFFFF"]V[/TD]
[TD="bgcolor: #FFFFFF"]Carrot[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]9[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</tbody>
Sheet1​



After the macro:

Excel 2007
ABCDEFGHI
PersonFMV
AndyOrangeBeefCarrot
BobbyAppleHamCarrot

<tbody>
[TD="align: center"]1[/TD]
[TD="bgcolor: #FFFFFF"]TID[/TD]
[TD="bgcolor: #FFFFFF"]Person[/TD]
[TD="bgcolor: #FFFFFF"]Type[/TD]
[TD="bgcolor: #FFFFFF"]Name[/TD]
[TD="align: right"][/TD]

[TD="align: center"]2[/TD]
[TD="bgcolor: #FFFFFF, align: right"]1[/TD]
[TD="bgcolor: #FFFFFF"]Andy[/TD]
[TD="bgcolor: #FFFFFF"]F[/TD]
[TD="bgcolor: #FFFFFF"]Orange[/TD]
[TD="align: right"][/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: #FFFFFF, align: right"]2[/TD]
[TD="bgcolor: #FFFFFF"]Andy[/TD]
[TD="bgcolor: #FFFFFF"]M[/TD]
[TD="bgcolor: #FFFFFF"]Beef[/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: #FFFFFF, align: right"]3[/TD]
[TD="bgcolor: #FFFFFF"]Andy[/TD]
[TD="bgcolor: #FFFFFF"]V[/TD]
[TD="bgcolor: #FFFFFF"]Carrot[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="bgcolor: #FFFFFF, align: right"]4[/TD]
[TD="bgcolor: #FFFFFF"]Andy[/TD]
[TD="bgcolor: #FFFFFF"]V[/TD]
[TD="bgcolor: #FFFFFF"]Spinach[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="bgcolor: #FFFFFF, align: right"]5[/TD]
[TD="bgcolor: #FFFFFF"]Bobby[/TD]
[TD="bgcolor: #FFFFFF"]M[/TD]
[TD="bgcolor: #FFFFFF"]Ham[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="bgcolor: #FFFFFF, align: right"]6[/TD]
[TD="bgcolor: #FFFFFF"]Bobby[/TD]
[TD="bgcolor: #FFFFFF"]F[/TD]
[TD="bgcolor: #FFFFFF"]Apple[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="bgcolor: #FFFFFF, align: right"]7[/TD]
[TD="bgcolor: #FFFFFF"]Bobby[/TD]
[TD="bgcolor: #FFFFFF"]V[/TD]
[TD="bgcolor: #FFFFFF"]Carrot[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]9[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

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

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.
Click to expand...

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.
 
Upvote 0
fosiza,

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

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

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.
Click to expand...

Will be back later with comments in the code to help you understand it.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Pivot Table help - Can I show certain data depending on value in another field
Replies
2
Views
1K
Monty85
M
T
  • Question Question
Dynamic Sheet Queries
Replies
1
Views
307
Vogateer
V
R
  • Solved
Replace cell reference
Replies
1
Views
359
dreid1011
dreid1011
M
  • Question Question
Formula Calculation is Inadvertently Switching from Automatic to Manual...
Replies
0
Views
390
MNexcelguy19
M
A
  • Question Question
input data from another workbook
Replies
1
Views
524
atditiljazi
A

Share this page

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