Need a macro to sort top 20 in a large datasheet based off a cell value

tonyjyoo

Board Regular
Joined
Aug 5, 2016
Messages
167
I have 2 tabs:

1. One is a large data sheet that has a bunch of client names and amounts (note for example like Google can appear more than once, so I would need the total amount, etc).

2. The second tab is a top sheet that I've been manually summing the top 20 clients, removing duplicates, etc.

Is there a way to write a macro to automatically find the top 20 clients and paste it into my top sheet? For reference, the large data sheet has amounts in column "U", client name in column "B". The second tab (top sheet), which I need client names to be pasted in, is in column B of that sheet.

I only need a way to find the top 20 clients. The top sheet I can pull numbers in through sumifs based on the client name.
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Ok, try this:
The first sheet must be the active sheet when you run the macro.
Change Sheets("Sheet2") to suit.

Code:
[FONT=lucida console][color=Royalblue]Sub[/color] aFrequency3()
[i][color=seagreen]'https://www.mrexcel.com/forum/excel-questions/1088206-need-macro-sort-top-20-large-datasheet-based-off-cell-value.html[/color][/i]
[color=Royalblue]Dim[/color] d [color=Royalblue]As[/color] [color=Royalblue]Object[/color]
[color=Royalblue]Dim[/color] i [color=Royalblue]As[/color] [color=Royalblue]Long[/color]
[color=Royalblue]Dim[/color] s [color=Royalblue]As[/color] [color=Royalblue]Variant[/color]
[color=Royalblue]Dim[/color] r [color=Royalblue]As[/color] Range

Application.ScreenUpdating = [color=Royalblue]False[/color]
[color=Royalblue]Set[/color] d = CreateObject([color=brown]"scripting.dictionary"[/color])
d.CompareMode = vbTextCompare

[color=Royalblue]For[/color] [color=Royalblue]Each[/color] r [color=Royalblue]In[/color] Range([color=brown]"B2:B"[/color] & Range([color=brown]"B"[/color] & Rows.count).[color=Royalblue]End[/color](xlUp).Row)
    s = Trim(r.Value)
    d(s) = d(s) + r.Offset(, [color=crimson]19[/color])
[color=Royalblue]Next[/color]

[color=Royalblue]With[/color] Sheets([color=brown]"Sheet2"[/color])
    .Range([color=brown]"B1:C"[/color] & .Range([color=brown]"B"[/color] & .Rows.count).[color=Royalblue]End[/color](xlUp).Row).ClearContents
    
    [color=Royalblue]Set[/color] r = .Range([color=brown]"B1"[/color]).Resize(d.count, [color=crimson]2[/color])
     r.Value = Application.Transpose(Array(d.Keys, d.items))
     r.Sort Key1:=r.Cells([color=crimson]1[/color], [color=crimson]2[/color]), order1:=xlDescending, Header:=xlNo
     r.Offset([color=crimson]20[/color]).ClearContents
[color=Royalblue]End[/color] [color=Royalblue]With[/color]

   Application.ScreenUpdating = [color=Royalblue]True[/color]
   
[color=Royalblue]End[/color] [color=Royalblue]Sub[/color]

[/FONT]
 
Upvote 0

Forum statistics

Threads
1,215,669
Messages
6,126,125
Members
449,293
Latest member
yallaire64

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