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

[Darth_Sullivan]

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.

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

 

[Darth_Sullivan]

May be try replace this

        '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.

        '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)

This is what I was trying to accomplish, thank you. My only issue with it is my number outputs whole numbers only. I need it to show to 2 decimal places and do not see where to alter to allow for that. Can you help?

 

[Darth_Sullivan]

This is what I was trying to accomplish, thank you. My only issue with it is my number outputs whole numbers only. I need it to show to 2 decimal places and do not see where to alter to allow for that. Can you help?

Nevermind, I saw the numbers dimmed as Integer and changed to Double. Everything seems to be working perfectly, thank you again!

 

[exceldevs]

You're welcome, thanks for the feedback.