find and list top 10 items in a table showing their row and column labels?

merlin777

Well-known Member
Joined
Aug 29, 2009
Messages
1,388
I have a table which summarises the number of sales of tshirts of each colour combination (its actually much bigger than this)

I'd like to show a list of the top 10 most popular colour combos so somehow i have to find the highest 10 values from these cells and display a list of them, in order, showing both colours and the number of sales they've had. I'm not sure how to go about this. Is there a function for this?


whiteblackredgreenblueyellowpinkgrey
white07000000
Ice Grey00000000
Sport Grey00000000
Vegas Gold00000000
Natural00000000
Sand03
000000
Daisy00000000
Safety Green00000000
Yellow Haze00000000
Gold00005000
Old Gold00000000

<colgroup><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

best sellers:
black on white - 7
blue on gold - 5
black on sand - 3
etc
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,669
This code applies to the layout shown below for the input data, although it will work as well if you add/delete rows/columns from the input data, though the output will be shifted if you add/delete columns from the input data.
Excel Workbook
ABCDEFGHIJKL
1whiteblackredgreenblueyellowpinkgreyTop10
2white07006000Gold on blue10
3Ice Grey00090070Ice Grey on green9
4Sport Grey00000000Safety Green on red8
5Vegas Gold05000000white on black7
6Natural00000000Ice Grey on pink7
7Sand00000000white on blue6
8Daisy00000000Vegas Gold on black5
9Safety Green00800000
10Yellow Haze00000000
11Gold000010000
12Old Gold00000000
Sheet3 (2)



Code:
Sub merlin777()
Dim Rin As Range, Vin As Variant, Rout As Range, Vout As Variant, RinNums As Range, Qty As Long
Dim i As Long, j As Long, k As Long, ct As Long
Const TopN As Long = 10  'Change to suit
Set Rin = Range("A1").CurrentRegion
Vin = Rin.Value
Set Rout = Rin(1).Offset(0, Rin.Columns.Count + 1)
Application.ScreenUpdating = False
With Rout.Resize(1, 2)
    .EntireColumn.ClearContents
    .Value = Array("Top", TopN)
End With
Set RinNums = Rin.Offset(1, 1).Resize(Rin.Rows.Count - 1, Rin.Columns.Count - 1)
ReDim Vout(1 To RinNums.Count, 1 To 2)
For i = 1 To TopN
    Qty = Evaluate("LARGE(" & RinNums.Address & "," & i & ")")
    If Qty > 0 Then
        For j = 2 To UBound(Vin, 1)
            For k = 2 To UBound(Vin, 2)
                If Vin(j, k) = Qty Then
                    ct = ct + 1
                    Vout(ct, 1) = Vin(j, 1) & " on " & Vin(1, k)
                    Vout(ct, 2) = Qty
                End If
            Next k
        Next j
    End If
Next i
With Rout.Offset(1, 0).Resize(ct, 2)
    .Value = Vout
    .RemoveDuplicates Columns:=Array(1, 2)
    .EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub
 

Eric W

MrExcel MVP
Joined
Aug 18, 2015
Messages
9,017
You can also do it with formulas:

Excel 2012
ABCDEFGHIJKL
1whiteblackredgreenblueyellowpinkgreyTop10
2white07006000Gold on blue10
3Ice Grey00090070Ice Grey on green9
4Sport Grey00000000Safety Green on red8
5Vegas Gold05000000white on black7
6Natural00000000Ice Grey on pink7
7Sand00000000white on blue6
8Daisy00000000Vegas Gold on black5
9Safety Green00800000
10Yellow Haze00000000
11Gold000010000
12Old Gold00000000
13

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet7

Array Formulas
CellFormula
K2{=IFERROR(INDEX(A:A,SMALL(IF($B$2:$I$12=L2,ROW($B$2:$I$12)*100+COLUMN($B$2:$I$12)),COUNTIF($L$2:$L2,L2))/100)&" on "&INDEX($1:$1,MOD(SMALL(IF($B$2:$I$12=L2,ROW($B$2:$I$12)*100+COLUMN($B$2:$I$12)),COUNTIF($L$2:$L2,L2)),100)),"")}
L2{=IFERROR(1/(1/LARGE($B$2:$I$12,ROWS($L$2:$L2))),"")}

<thead>
</thead><tbody>
</tbody>
Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}.
Note: Do not try and enter the {} manually yourself

<tbody>
</tbody>
 

sandy666

Well-known Member
Joined
Oct 24, 2015
Messages
3,857
another way with PowerQuery (Get&Transform)

itemswhiteblackredgreenblueyellowpinkgreyONValue
white
0​
7​
0​
0​
0​
0​
0​
0​
Old Gold on green
10​
Ice Grey
0​
0​
0​
0​
0​
0​
0​
0​
white on black
7​
Sport Grey
0​
0​
0​
0​
0​
0​
0​
0​
Gold on blue
5​
Vegas Gold
0​
0​
0​
0​
0​
0​
0​
0​
Sand on black
3​
Natural
0​
0​
0​
0​
0​
0​
0​
0​
white on pink
0​
Sand
0​
3​
0​
0​
0​
0​
0​
0​
white on yellow
0​
Daisy
0​
0​
0​
0​
0​
0​
0​
0​
white on red
0​
Safety Green
0​
0​
0​
0​
0​
0​
0​
0​
Old Gold on grey
0​
Yellow Haze
0​
0​
0​
0​
0​
0​
0​
0​
Old Gold on pink
0​
Gold
0​
0​
0​
0​
5​
0​
0​
0​
Old Gold on yellow
0​
Old Gold
0​
0​
0​
10​
0​
0​
0​
0​

Code:
[SIZE=1]// Table1
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Unpivot = Table.UnpivotOtherColumns(Source, {"items"}, "Attribute", "Value"),
    Sort = Table.Sort(Unpivot,{{"Value", Order.Descending}}),
    Merge = Table.CombineColumns(Sort,{"items", "Attribute"},Combiner.CombineTextByDelimiter(" on ", QuoteStyle.None),"ON"),
    TopTen = Table.FirstN(Merge,10)
in
    TopTen[/SIZE]
 

merlin777

Well-known Member
Joined
Aug 29, 2009
Messages
1,388
This code applies to the layout shown below for the input data, although it will work as well if you add/delete rows/columns from the input data, though the output will be shifted if you add/delete columns from the input data.
Sheet3 (2)

ABCDEFGHIJKL
1 whiteblackredgreenblueyellowpinkgrey Top10
2white07006000 Gold on blue10
3Ice Grey00090070 Ice Grey on green9
4Sport Grey00000000 Safety Green on red8
5Vegas Gold05000000 white on black7
6Natural00000000 Ice Grey on pink7
7Sand00000000 white on blue6
8Daisy00000000 Vegas Gold on black5
9Safety Green00800000
10Yellow Haze00000000
11Gold000010000
12Old Gold00000000

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:87px;"><col style="width:43px;"><col style="width:39px;"><col style="width:28px;"><col style="width:43px;"><col style="width:35px;"><col style="width:49px;"><col style="width:34px;"><col style="width:34px;"><col style="width:43px;"><col style="width:132px;"><col style="width:21px;"></colgroup><tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4


Code:
Sub merlin777()
Dim Rin As Range, Vin As Variant, Rout As Range, Vout As Variant, RinNums As Range, Qty As Long
Dim i As Long, j As Long, k As Long, ct As Long
Const TopN As Long = 10  'Change to suit
Set Rin = Range("A1").CurrentRegion
Vin = Rin.Value
Set Rout = Rin(1).Offset(0, Rin.Columns.Count + 1)
Application.ScreenUpdating = False
With Rout.Resize(1, 2)
    .EntireColumn.ClearContents
    .Value = Array("Top", TopN)
End With
Set RinNums = Rin.Offset(1, 1).Resize(Rin.Rows.Count - 1, Rin.Columns.Count - 1)
ReDim Vout(1 To RinNums.Count, 1 To 2)
For i = 1 To TopN
    Qty = Evaluate("LARGE(" & RinNums.Address & "," & i & ")")
    If Qty > 0 Then
        For j = 2 To UBound(Vin, 1)
            For k = 2 To UBound(Vin, 2)
                If Vin(j, k) = Qty Then
                    ct = ct + 1
                    Vout(ct, 1) = Vin(j, 1) & " on " & Vin(1, k)
                    Vout(ct, 2) = Qty
                End If
            Next k
        Next j
    End If
Next i
With Rout.Offset(1, 0).Resize(ct, 2)
    .Value = Vout
    .RemoveDuplicates Columns:=Array(1, 2)
    .EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub
You are a magician, sir. Just tweaking it to fit now.
If I want the results on another sheet how would i need to change it? The sheet is called 'mostpopular'.

Also I have 3 sheets with a table on each. Ive put the vba in the sheet called 'tshirttotals' where the data and results currently appear. I want to do the same with 'hoodietotals' and 'captotals' - do i just put the vba into those sheets and name the subs eg 'merlin1' 'merlin2' and 'merlin3' etc or will they get confused?
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,669
You are a magician, sir. Just tweaking it to fit now.
If I want the results on another sheet how would i need to change it? The sheet is called 'mostpopular'.

Also I have 3 sheets with a table on each. Ive put the vba in the sheet called 'tshirttotals' where the data and results currently appear. I want to do the same with 'hoodietotals' and 'captotals' - do i just put the vba into those sheets and name the subs eg 'merlin1' 'merlin2' and 'merlin3' etc or will they get confused?
I've posted modified code below to address your new questions/requests. The code is setup to be executed from the sheet containing the raw data, and currently the output is going to a sheet named "mostpopular" starting in A1.

If you want the output from hoodies and caps to go to this same sheet (mostpopular) just let me know what columns you want to use for each output. Then you can put a command button on each raw data sheet with each button assigned to the same code and I can adjust the code so it directs the output to the correct columns on the sheet 'mostpopular'. To do this I will use the sheet name info you have provided: Raw data for t-shirts on sheet "tshirttotals", for hoodies on "hoodietotals", and caps on "captotals".

Test the modified code first and let me know how it goes.
Code:
Sub merlin777_2()
'run this from the sheet that holds the raw data
Dim Rin As Range, Vin As Variant, Rout As Range, Vout As Variant, RinNums As Range, Qty As Long
Dim i As Long, j As Long, k As Long, ct As Long
Const TopN As Long = 10  'Change to suit
Set Rin = Range("A1").CurrentRegion
Vin = Rin.Value
Set Rout = Sheets("mostpopular").Range("A1")   'Change destination sheet for output here
Application.ScreenUpdating = False
With Rout.Resize(1, 2)
    .EntireColumn.ClearContents
    .Value = Array("Top", TopN)
End With
Set RinNums = Rin.Offset(1, 1).Resize(Rin.Rows.Count - 1, Rin.Columns.Count - 1)
ReDim Vout(1 To RinNums.Count, 1 To 2)
For i = 1 To TopN
    Qty = Evaluate("LARGE(" & RinNums.Address & "," & i & ")")
    If Qty > 0 Then
        For j = 2 To UBound(Vin, 1)
            For k = 2 To UBound(Vin, 2)
                If Vin(j, k) = Qty Then
                    ct = ct + 1
                    Vout(ct, 1) = Vin(j, 1) & " on " & Vin(1, k)
                    Vout(ct, 2) = Qty
                End If
            Next k
        Next j
    End If
Next i
With Rout.Offset(1, 0).Resize(ct, 2)
    .Value = Vout
    .RemoveDuplicates Columns:=Array(1, 2)
    .EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub
 

merlin777

Well-known Member
Joined
Aug 29, 2009
Messages
1,388
Really appreciate that Joe. I've taken what you said and had a play myself. Been a while but some of its coming back to me. Had a brain op and I thought I'd be starting again from scratch.
I repeated your code, with a different name, on each of the total sheets and just went lotech by linking to the output results from most popular.
I tried running all 3 at once by calling them from within a macro but I just got errors so I went back to having one on each sheet and put 3 'update' buttons to run the macros from mostpopular. I now have the desired result so I'm very grateful to you. I'd be interested to know why I couldn't call them all from one macro without them being on the same sheet and why that then gave me errors but otherwise I'm a happy bunny.
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,669
Really appreciate that Joe. I've taken what you said and had a play myself. Been a while but some of its coming back to me. Had a brain op and I thought I'd be starting again from scratch.
I repeated your code, with a different name, on each of the total sheets and just went lotech by linking to the output results from most popular.
I tried running all 3 at once by calling them from within a macro but I just got errors so I went back to having one on each sheet and put 3 'update' buttons to run the macros from mostpopular. I now have the desired result so I'm very grateful to you. I'd be interested to know why I couldn't call them all from one macro without them being on the same sheet and why that then gave me errors but otherwise I'm a happy bunny.
Glad I could help and that you were able to produce a solution that you are satisfied with. Can't diagnose your problem calling the 3 macros w/o seeing your code and you telling me exactly what error message(s) you received and on what line(s) the message(s) appeared.
 

merlin777

Well-known Member
Joined
Aug 29, 2009
Messages
1,388
beautiful - thanks joe.
You can also do it with formulas:

Excel 2012
ABCDEFGHIJKL
1whiteblackredgreenblueyellowpinkgreyTop10
2white07006000Gold on blue10
3Ice Grey00090070Ice Grey on green9
4Sport Grey00000000Safety Green on red8
5Vegas Gold05000000white on black7
6Natural00000000Ice Grey on pink7
7Sand00000000white on blue6
8Daisy00000000Vegas Gold on black5
9Safety Green00800000
10Yellow Haze00000000
11Gold000010000
12Old Gold00000000
13

<tbody>
</tbody>
Sheet7

Array Formulas
CellFormula
K2{=IFERROR(INDEX(A:A,SMALL(IF($B$2:$I$12=L2,ROW($B$2:$I$12)*100+COLUMN($B$2:$I$12)),COUNTIF($L$2:$L2,L2))/100)&" on "&INDEX($1:$1,MOD(SMALL(IF($B$2:$I$12=L2,ROW($B$2:$I$12)*100+COLUMN($B$2:$I$12)),COUNTIF($L$2:$L2,L2)),100)),"")}
L2{=IFERROR(1/(1/LARGE($B$2:$I$12,ROWS($L$2:$L2))),"")}

<tbody>
</tbody>
Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}.
Note: Do not try and enter the {} manually yourself

<tbody>
</tbody>
 

merlin777

Well-known Member
Joined
Aug 29, 2009
Messages
1,388
Glad I could help and that you were able to produce a solution that you are satisfied with. Can't diagnose your problem calling the 3 macros w/o seeing your code and you telling me exactly what error message(s) you received and on what line(s) the message(s) appeared.
I've just noticed something strange is going on.
Its not actually retrning the top number that is being asked for.
When i change the 10 (change to suit) to other numbers this is what i get

ask for top 1 and get a list of 1
2 gives 2
3 = 3
4 = 4
but 5 gives 9
6 = 9
7 = 9
8 = 9
9 = 9
then 10 gives 15
11 = 15

and so on.

?
 

Forum statistics

Threads
1,082,603
Messages
5,366,578
Members
400,904
Latest member
ndaines meriabi

Some videos you may like

This Week's Hot Topics

Top