Bringing back column headings for descending values

[kimhesk]

Hi, i hope someone can help me as this is driving me potty.

I have student grades listed like below

	Biology	Chemistry	History	Physics
Student 1	6	7	7	2
Student 2	3	4	5	5
Student 3	1	0	2	3

<!--StartFragment--> <colgroup><col width="65" span="5" style="width:65pt"> </colgroup><tbody>

<!--EndFragment-->​

</tbody>

and I want to bring back the subject names in descending order, like below:

	Biology	Chemistry	History	Physics	1st	2nd	3rd	4th
Student 1	6	7	7	2	Chemistry	History	Biology	Physics
Student 2	3	4	5	5	History	Physics	Chemistry	Biology
Student 3	1	0	2	3	Physics	History	Biology	Chemistry

<colgroup><col span="5"><col span="4"></colgroup><tbody>
</tbody>

I can do it in the case of student 3 by using a mix of index, match and large functions but I cannot get it to work properly where i have duplicate grades.

If you have a code that works could you also briefly explain what each bit does as i have a much larger sample i need to apply it to,

Thanks

 

[kimhesk]

Does anyone have any ideas?
I tried combining the numbers and text e.g. 3 Biology 5 Physics 5 History and then trying to sort in descending order but it doesn't recognise the numbers when I sort, only the text, very frustrating!

 

[Marcelo Branco]

Try

	A​	B​	C​	D​	E​	F​	G​	H​	I​
1​		Biology​	Chemistry​	History​	Physics​	1st​	2nd​	3rd​	4th​
2​	Student 1​	6​	7​	7​	2​	Chemistry​	History​	Biology​	Physics​
3​	Student 2​	3​	4​	5​	5​	History​	Physics​	Chemistry​	Biology​
4​	Student 3​	1​	0​	2​	3​	Physics​	History​	Biology​	Chemistry​

Array formula in F2 copied across till I2 and down
=INDEX($B$1:$E$1,SMALL(IF(ISNA(MATCH($B$1:$E$1,$E2:E2,0)),IF($B2:$E2=LARGE($B2:$E2,COLUMNS($F2:F2)),COLUMN($B2:$E2)-COLUMN($B2)+1)),1))
Ctrl+Shift+Enter

M.

 

[MickG]

Code option :-

[COLOR="Navy"]Sub[/COLOR] MG14Aug26
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] S [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, Sp [COLOR="Navy"]As[/COLOR] Variant, Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Lst = Cells("2", Columns.Count).End(xlToLeft).Column
[COLOR="Navy"]Set[/COLOR] Rng = Rng.Resize(, Lst)
[COLOR="Navy"]For[/COLOR] n = 2 To Rng.Rows.Count
 nStr = ""
 [COLOR="Navy"]Set[/COLOR] R = Rng.Rows(n).Offset(, 1).Resize(, Rng.Rows(n).Columns.Count - 1)
   c = 0
   [COLOR="Navy"]For[/COLOR] Ac = 1 To Rng.Columns.Count - 1
       c = c + 1
       nStr = nStr & IIf(nStr = "", Application.Large(R, c), "," & Application.Large(R, c))
    [COLOR="Navy"]Next[/COLOR] Ac
Sp = Split(nStr, ",")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] R.Cells
    [COLOR="Navy"]For[/COLOR] S = 0 To UBound(Sp)
        [COLOR="Navy"]If[/COLOR] CStr(Dn.Value) = Sp(S) [COLOR="Navy"]Then[/COLOR]
             Cells(Dn.Row, R.Columns.Count + 2 + S) = Cells(1, Dn.Column)
             Sp(S) = ""
             [COLOR="Navy"]Exit[/COLOR] For
        [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] S
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[kimhesk]

Thanks for this, will this code work for 9 columns of grades or would it need to be tweaked? (either VBA or the formula)

 

[MickG]

The code should be good for as many columns as you like.
NB:- I have altered the code slightly because if you try to run the code a second time , the original results will throw an error. With this code you get a msgbox to tell you to remove the results and retry.

[COLOR=navy]Sub[/COLOR] MG14Aug16
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, nStr [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] S [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] R [COLOR=navy]As[/COLOR] Range, Sp [COLOR=navy]As[/COLOR] Variant, Lst [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Lst = Cells("2", Columns.Count).End(xlToLeft).Column
[COLOR=navy]If[/COLOR] IsNumeric(Cells(2, Lst)) [COLOR=navy]Then[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Rng.Resize(, Lst)
[COLOR=navy]For[/COLOR] n = 2 To Rng.Rows.Count
 nStr = ""
 [COLOR=navy]Set[/COLOR] R = Rng.Rows(n).Offset(, 1).Resize(, Rng.Rows(n).Columns.Count - 1)
   c = 0
   [COLOR=navy]For[/COLOR] Ac = 1 To Rng.Columns.Count - 1
       c = c + 1
       nStr = nStr & IIf(nStr = "", Application.Large(R, c), "," & Application.Large(R, c))
    [COLOR=navy]Next[/COLOR] Ac
Sp = Split(nStr, ",")
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] R.Cells
    [COLOR=navy]For[/COLOR] S = 0 To UBound(Sp)
        [COLOR=navy]If[/COLOR] CStr(Dn.Value) = Sp(S) [COLOR=navy]Then[/COLOR]
             Cells(Dn.Row, R.Columns.Count + 2 + S) = Cells(1, Dn.Column)
             Sp(S) = ""
             [COLOR=navy]Exit[/COLOR] For
        [COLOR=navy]End[/COLOR] If
   [COLOR=navy]Next[/COLOR] S
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]Else[/COLOR]
 MsgBox "Remove Results and retry"
[COLOR=navy]End[/COLOR] [COLOR=navy]If[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

PS:-As Marcelo spotted the Variable "Lst" is used to get the last Column in your data.

 

[Marcelo Branco]

Not tested, but i think the code provided by Mick would work perfectly - he used a variable (Lst) to get the last column with data. Am i right, Mick?

In my formula the ranges must be adjusted to suit.

M.