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

M

merlin777

Well-known Member
Joined
Aug 29, 2009
Messages
1,397
Office Version
  1. 2007
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
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
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
 
Upvote 0
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>
 
Upvote 0
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]
 
Upvote 0
JoeMo said:
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
Click to expand...

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?
 
Upvote 0
merlin777 said:
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?
Click to expand...
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
 
Upvote 0
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.
 
Upvote 0
merlin777 said:
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.
Click to expand...
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.
 
Upvote 0
beautiful - thanks joe.
Eric W said:
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>
Click to expand...
 
Upvote 0
JoeMo said:
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.
Click to expand...
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.

?
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Formula to find Max number of items in orders
Replies
1
Views
476
fjns
F
M
  • Question
extract a list of colour combinations from a table
2
Replies
12
Views
1K
JoeMo
J
T
  • Question
Need help returning average of top 3 scores from most recent 5 at a moment in time
Replies
4
Views
749
AhoyNC
A
M
  • Question
Change some font colour from black to white
Replies
2
Views
539
motilulla
M
M
  • Question
Do 2-font colour according (in the area) as per list parameters
Replies
7
Views
524
motilulla
M

Forum statistics

Threads
1,214,606
Messages
6,120,478
Members
448,967
Latest member
visheshkotha

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