Using Large to get Top 5, 2 values are the same... VBA

D

Darth_Sullivan

New Member
Joined
Oct 23, 2013
Messages
48
My code, which is functional, finds the top 5 point earners and displays their name and points they earned. Everything works great, except when two people have the same points earned. When two people have the same points, the first name with those points is just shown twice. How can I get the second name of someone with the same points to be shown? This of course is only if more than 1 person have the same number of points.

Code: 
Private Sub ComboBox1_Change()

Dim top1 As Double
Dim top2 As Double
Dim top3 As Double
Dim top4 As Double
Dim Top5 As Double

Dim name1 As String
Dim name2 As String
Dim name3 As String
Dim name4 As String
Dim name5 As String

Dim PTSrng As Range
Dim NAMErng As Range
Dim MONTHrng As Variant

If ComboBox1.ListIndex = 0 Then
        MONTHrng = "$C$2:$C$65536"
    ElseIf ComboBox1.ListIndex = 1 Then
        MONTHrng = "$D$2:$D$65536"
    ElseIf ComboBox1.ListIndex = 2 Then
        MONTHrng = "$E$2:$E$65536"
    ElseIf ComboBox1.ListIndex = 3 Then
        MONTHrng = "$F$2:$F$65536"
    ElseIf ComboBox1.ListIndex = 4 Then
        MONTHrng = "$G$2:$G$65536"
    ElseIf ComboBox1.ListIndex = 5 Then
        MONTHrng = "$H$2:$H$65536"
    ElseIf ComboBox1.ListIndex = 6 Then
        MONTHrng = "$I$2:$I$65536"
    ElseIf ComboBox1.ListIndex = 7 Then
        MONTHrng = "$J$2:$J$65536"
    ElseIf ComboBox1.ListIndex = 8 Then
        MONTHrng = "$K$2:$K$65536"
    ElseIf ComboBox1.ListIndex = 9 Then
        MONTHrng = "$L$2:$L$65536"
    ElseIf ComboBox1.ListIndex = 10 Then
        MONTHrng = "$M$2:$M$65536"
    ElseIf ComboBox1.ListIndex = 11 Then
        MONTHrng = "$N$2:$N$65536"
    Else
    MsgBox ("Invalid Month Selected")
    Exit Sub
End If

Set PTSrng = Worksheets("Sheet1").Range(MONTHrng)
Set NAMErng = Worksheets("Sheet1").Range("$B$2:$B$65536")


top1 = WorksheetFunction.Large(PTSrng, 1)
top2 = WorksheetFunction.Large(PTSrng, 2)
top3 = WorksheetFunction.Large(PTSrng, 3)
top4 = WorksheetFunction.Large(PTSrng, 4)
Top5 = WorksheetFunction.Large(PTSrng, 5)

'INDEX(Sheet1!$B$2:$B$65536,MATCH(B4,Sheet1!$C$2:$C$65536,0))
name1 = WorksheetFunction.Index(NAMErng, WorksheetFunction.Match(top1, PTSrng, 0))
name2 = WorksheetFunction.Index(NAMErng, WorksheetFunction.Match(top2, PTSrng, 0))
name3 = WorksheetFunction.Index(NAMErng, WorksheetFunction.Match(top3, PTSrng, 0))
name4 = WorksheetFunction.Index(NAMErng, WorksheetFunction.Match(top4, PTSrng, 0))
name5 = WorksheetFunction.Index(NAMErng, WorksheetFunction.Match(Top5, PTSrng, 0))

Label1 = name1
Label2 = top1

Label3 = name2
Label4 = top2

Label5 = name3
Label6 = top3

Label7 = name4
Label8 = top4

Label9 = name5
Label10 = Top5

End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
By making use your existing code which leverage on Excel built-in functions, try below (untested).

Code: 
name1 = WorksheetFunction.INDEX(NAMErng, WorksheetFunction.SMALL(WorksheetFunction.IF(PTSrng <= Top5, WorksheetFunction.ROW(PTSrng)), 1))
name2 = WorksheetFunction.INDEX(NAMErng, WorksheetFunction.SMALL(WorksheetFunction.IF(PTSrng <= Top5, WorksheetFunction.ROW(PTSrng)), 2))
name3 = WorksheetFunction.INDEX(NAMErng, WorksheetFunction.SMALL(WorksheetFunction.IF(PTSrng <= Top5, WorksheetFunction.ROW(PTSrng)), 3))
name4 = WorksheetFunction.INDEX(NAMErng, WorksheetFunction.SMALL(WorksheetFunction.IF(PTSrng <= Top5, WorksheetFunction.ROW(PTSrng)), 4))
name5 = WorksheetFunction.INDEX(NAMErng, WorksheetFunction.SMALL(WorksheetFunction.IF(PTSrng <= Top5, WorksheetFunction.ROW(PTSrng)), 5))
 
Upvote 0
exceldevs said:
By making use your existing code which leverage on Excel built-in functions, try below (untested).

Code: 
name1 = WorksheetFunction.INDEX(NAMErng, WorksheetFunction.SMALL(WorksheetFunction.IF(PTSrng <= Top5, WorksheetFunction.ROW(PTSrng)), 1))
name2 = WorksheetFunction.INDEX(NAMErng, WorksheetFunction.SMALL(WorksheetFunction.IF(PTSrng <= Top5, WorksheetFunction.ROW(PTSrng)), 2))
name3 = WorksheetFunction.INDEX(NAMErng, WorksheetFunction.SMALL(WorksheetFunction.IF(PTSrng <= Top5, WorksheetFunction.ROW(PTSrng)), 3))
name4 = WorksheetFunction.INDEX(NAMErng, WorksheetFunction.SMALL(WorksheetFunction.IF(PTSrng <= Top5, WorksheetFunction.ROW(PTSrng)), 4))
name5 = WorksheetFunction.INDEX(NAMErng, WorksheetFunction.SMALL(WorksheetFunction.IF(PTSrng <= Top5, WorksheetFunction.ROW(PTSrng)), 5))
Click to expand...

I got a Type Mismatch Error...

I think what I'm looking for is something along the lines of

If top2 = top1 then name2 is the name associated with the second occurrence of the value returned by top1

then I can apply that same logic to top3-top5...
 
Upvote 0
On second thought, try codes below which can be tweaked easily if more number of tops are required.

Code: 
Private Sub ComboBox1_Change()
    Dim LASTrow As Long: LASTrow = Range("b" & Rows.Count).End(xlUp).row
    Dim MONTHrng, NAMErng As Range: Set NAMErng = Range("B2:B" & LASTrow)
    Dim x, y, TMPname, TMPmonth, MONTHarr() As Integer: ReDim MONTHarr(LASTrow - 1)
    Dim NAMEarr() As String: ReDim NAMEarr(LASTrow - 1)
    Dim rng As Range
    
    Application.ScreenUpdating = False
    With Sheets("Sheet1")
        'Define range for selected index and save them to arrays
        If ComboBox1.ListIndex >= 0 Then
            Set MONTHrng = .Range(.Cells(2, 3), .Cells(LASTrow, 3)).Offset(, ComboBox1.ListIndex)
            For Each rng In MONTHrng
                NAMEarr(rng.row - 2) = .Range("B" & rng.row).Value
                MONTHarr(rng.row - 2) = rng.Value
            Next rng
        Else
            MsgBox ("Invalid Month Selected")
            Exit Sub
        End If
        
        'Sort name column base on month column
        For x = LBound(MONTHarr) To UBound(MONTHarr)
            For y = x + 1 To UBound(MONTHarr)
                If MONTHarr(x) < MONTHarr(y) Then
                    TMPmonth = MONTHarr(y)
                    TMPname = NAMEarr(y)
                    MONTHarr(y) = MONTHarr(x)
                    NAMEarr(y) = NAMEarr(x)
                    MONTHarr(x) = TMPmonth
                    NAMEarr(x) = TMPname
                End If
            Next y
        Next x
        
        'Output result to respective labels
        For x = 1 To 9 Step 2
            .OLEObjects("Label" & x).Object.Caption = NAMEarr((x - 1) / 2)
            .OLEObjects("Label" & x + 1).Object.Caption = MONTHarr((x - 1) / 2)
        Next x
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
exceldevs said:
On second thought, try codes below which can be tweaked easily if more number of tops are required.

Code: 
Private Sub ComboBox1_Change()
    Dim LASTrow As Long: LASTrow = Range("b" & Rows.Count).End(xlUp).row
    Dim MONTHrng, NAMErng As Range: Set NAMErng = Range("B2:B" & LASTrow)
    Dim x, y, TMPname, TMPmonth, MONTHarr() As Integer: ReDim MONTHarr(LASTrow - 1)
    Dim NAMEarr() As String: ReDim NAMEarr(LASTrow - 1)
    Dim rng As Range
    
    Application.ScreenUpdating = False
    With Sheets("Sheet1")
        'Define range for selected index and save them to arrays
        If ComboBox1.ListIndex >= 0 Then
            Set MONTHrng = .Range(.Cells(2, 3), .Cells(LASTrow, 3)).Offset(, ComboBox1.ListIndex)
            For Each rng In MONTHrng
                NAMEarr(rng.row - 2) = .Range("B" & rng.row).Value
                MONTHarr(rng.row - 2) = rng.Value
            Next rng
        Else
            MsgBox ("Invalid Month Selected")
            Exit Sub
        End If
        
        'Sort name column base on month column
        For x = LBound(MONTHarr) To UBound(MONTHarr)
            For y = x + 1 To UBound(MONTHarr)
                If MONTHarr(x) < MONTHarr(y) Then
                    TMPmonth = MONTHarr(y)
                    TMPname = NAMEarr(y)
                    MONTHarr(y) = MONTHarr(x)
                    NAMEarr(y) = NAMEarr(x)
                    MONTHarr(x) = TMPmonth
                    NAMEarr(x) = TMPname
                End If
            Next y
        Next x
        
        'Output result to respective labels
        For x = 1 To 9 Step 2
            .OLEObjects("Label" & x).Object.Caption = NAMEarr((x - 1) / 2)
            .OLEObjects("Label" & x + 1).Object.Caption = MONTHarr((x - 1) / 2)
        Next x
    End With
    Application.ScreenUpdating = True
End Sub
Click to expand...

When using this code, I get:

Run-time error '1004':
Unable to get the OLEObjects property of the Worksheet class

If it helps, I didn't state before but this is on a userform. I don't know what I need to change to see if this code will work. I am new to vba and not too familiar with much. When clicking debug after getting the error, this line is what gets highlighted:

Code: 
            .OLEObjects("Label" & x).Object.Caption = NAMEarr((x - 1) / 2)

Thank you for helping
 
Upvote 0
I see.

It seems to me that you're using ActiveX Controls for ComboBox, how about Labels?
Are you using ActiveX or Form Controls for Labels?
 
Upvote 0
May be try replace this
Code: 
        'Output result to respective labels
        For x = 1 To 9 Step 2
            .OLEObjects("Label" & x).Object.Caption = NAMEarr((x - 1) / 2)
            .OLEObjects("Label" & x + 1).Object.Caption = MONTHarr((x - 1) / 2)
        Next x

with this to get it working.
Code: 
        'Output result to respective labels
        Label1 = NAMEarr(0)
        Label2 = MONTHarr(0)
        Label3 = NAMEarr(1)
        Label4 = MONTHarr(1)
        Label5 = NAMEarr(2)
        Label6 = MONTHarr(2)
        Label7 = NAMEarr(3)
        Label8 = MONTHarr(3)
        Label9 = NAMEarr(4)
        Label10 = MONTHarr(4)
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Doing a Left VLOOKUP using VBA code?
Replies
5
Views
15K
Jonmo1
Jonmo1
L
  • Question
Index with Match By Code
Replies
6
Views
467
meldoc
M

Forum statistics

Threads
1,215,563
Messages
6,125,565
Members
449,237
Latest member
Chase S

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