VBA Name Ranking

DarrenF

Board Regular
Joined
Jun 9, 2014
Messages
88
I'm trying to Rank the number of times a name show's up in a particular column ("Report Data" Column B) and have it Rank the top ten on another sheet ("Report" starting in cell A16). I haven't been successful finding anything while googling. Does anyone have a good reference video or would like to share what it would look like?

Example:

Data
Jim
Mary
Mike
Paul
Sam
Mary
Jim
Jim
Judy
Mike

Results
1. Jim 3
2. Mary 2
3. Mike 2
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
3,142
Office Version
  1. 365
Platform
  1. Windows
How about this.

Book1 (version 2).xlsb
AB
16NameCount
17Jim3
18Mary2
19Mike2
20Paul1
21Sam1
22Judy1
Report


VBA Code:
Sub RankIT()
Dim rd As Worksheet:    Set rs = Sheets("Report Data")
Dim rp As Worksheet:    Set rp = Sheets("Report")
Dim r As Range:         Set r = rs.Range("A2:A" & rs.Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(AR)
    SD(AR(i, 1)) = SD(AR(i, 1)) + 1
Next i

Set r = rp.Range("A16:B16")
r.Value = Array("Name", "Count")
Set r = r.Offset(1).Resize(SD.Count, 1)
r.Value = Application.Transpose(SD.keys())
r.Offset(, 1).Value = Application.Transpose(SD.items())
Set r = r.Resize(, 2)
r.Sort Key1:=r.Cells(1, 2), Order1:=xlDescending, Header:=xlNo

End Sub
 

DarrenF

Board Regular
Joined
Jun 9, 2014
Messages
88
Thank you lrobbo314, that worked for the most part. Is there a way to only grab the top 10? Also, leave out any #N/A's? Sorry I know I'm asking for alot.
 

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
3,142
Office Version
  1. 365
Platform
  1. Windows
I didn't get any N/As in with the test data you posted. Not sure how to fix that without knowing what's causing it. Can you post a more representative example.

Adding this line of code at the end of the sub will filter for the top 10.

VBA Code:
r.AutoFilter Field:=2, Criteria1:="10", Operator:=xlTop10Items
 

DarrenF

Board Regular
Joined
Jun 9, 2014
Messages
88
Yeah, my data that I'm grabbing is actually trying to pull Names, but if that person who entered the data didn't put the first name in the tool it will show up #N/A in my data pull. I'd like to extract those if possible as it will always show up at #1.
 

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
3,142
Office Version
  1. 365
Platform
  1. Windows
How about this?

VBA Code:
Sub RankIT()
Dim rd As Worksheet:    Set rs = Sheets("Report Data")
Dim rp As Worksheet:    Set rp = Sheets("Report")
Dim r As Range:         Set r = rs.Range("A2:A" & rs.Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")
Dim Top As Integer:     Top = 10
Dim RES() As Variant:   ReDim RES(1 To Top, 1 To 2)

For i = 1 To UBound(AR)
    If Not IsError(AR(i, 1)) Then SD(AR(i, 1)) = SD(AR(i, 1)) + 1
Next i

For j = 0 To SD.Count - 1
    RES(j + 1, 1) = SD.Keys()(j)
    RES(j + 1, 2) = SD.Items()(j)
    Top = Top - 1
    If Top = 0 Then Exit For
Next j

Set r = rp.Range("A16:B16")
r.Value = Array("Name", "Count")
r.Offset(1).Resize(UBound(RES), 2).Value2 = RES

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,129,689
Messages
5,637,837
Members
416,985
Latest member
mrindira

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
Top