Finding row numbers of the top 10 largest numbers in a range

Mann750

Board Regular
Joined
Dec 16, 2009
Messages
72
Hi,

I have been using the Application.WorksheetFunction.Large to find the top 10 numbers in a range but I cannot seem to get the rest of the code to find the corresponding row number when there are duplicate values. My code so far is as below:

Code:
Sub Top10Values()
Dim rngTestArea As Range, k As Integer, j As Long, MyResult As String, rowcount As Long, lastrow as long
Dim report As Worksheet, register As Worksheet

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set report = Worksheets("REPORT")
Set register = Worksheets("Register")

lastrow = register.Cells(Rows.Count, 17).End(xlUp).Row
Set rngTestArea = register.Range("Q2:Q" & lastrow)
j = 0
For k = 1 To 10
    j = Application.WorksheetFunction.Large(rngTestArea, k)
        If j > 0 Then
        rowcount = register.Columns(17).Find(what:=j, after:=Cells(7, 17), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows).Row
            MyResult = MyResult & "Rank " & k & " is " & j & " in row " & rowcount & vbCr
        End If
Next k

MsgBox MyResult
End Sub
The values in the range are not in ascending/descending order and there will always be duplicates. The Large function does find all the top 10 values, including duplicates, but it is just the row function that needs tweaking.

For reference I will be using the row number to lookup the corresponding ID number to the top 10 value in another column and plot it on a heat map. The message box is just a little test to see if the values are being picked up correctly.

Many thanks!!!
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
the data is lilke this 1 to 20 randomly placed in cells in collumn A

Excel Workbook
A
1hdng1
214
36
49
55
63
71
82
916
1010
1118
1217
1319
1415
1512
168
177
184
1911
2020
2113
Sheet1



run this macro FOR THIS DATA and see column D and E. CONFIRM YOU GOT WHAT YOU WANT. MODIFY MCRO FOR YOUR DATA.



Code:
Sub test()
Dim r As Range, rrow(1 To 10), i As Integer, mmax(1 To 10)
Range("D1:E1").EntireColumn.Delete
Set r = Range(Range("A2"), Range("A2").End(xlDown))
For i = 1 To 10
mmax(i) = WorksheetFunction.Large(r, i)
'MsgBox mmax(i)
rrow(i) = WorksheetFunction.Match(mmax(i), r, 0)
'MsgBox rrow(i)
Cells(i + 1, "D") = mmax(i)
Cells(i + 1, "E") = rrow(i) + 1


Cells(1, "D") = "laragenumbrs"
Cells(1, "E") = "corrspnding row"
Next i
End Sub
 

Mann750

Board Regular
Joined
Dec 16, 2009
Messages
72
Hello again,

I've been searching for an answer to the above problem and I have come across the 'FindNext' function. I have managed to change my code to incorporate this and it IS working but I would like the concatenated results to be split and assigned to the correct ranked value. My code is below:

Code:
Sub Max10v2()
Dim rngTestArea As Range, rowcount As Range, rowcount1 As Range
Dim k As Integer, j As Long, lastrow As Long
Dim ExitLoop As Boolean
Dim FoundAt As String, MyResult As String
Dim report As Worksheet, register As Worksheet

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set report = Worksheets("REPORT")
Set register = Worksheets("Register")
lastrow = register.Cells(Rows.Count, 17).End(xlUp).Row
Set rngTestArea = register.Range("Q2:Q" & lastrow)
j = 0
For k = 1 To 10
    j = Application.WorksheetFunction.Large(rngTestArea, k)
        If j > 0 Then
            Set rowcount = rngTestArea.Find(what:=j, after:=Cells(7, 17).Offset(1), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
                If Not rowcount Is Nothing Then
                    Set rowcount1 = rowcount
                    FoundAt = rowcount.Address
                    Do While ExitLoop = False
                        Set rowcount = rngTestArea.FindNext(after:=rowcount)
                        If Not rowcount Is Nothing Then
                            If rowcount.Address = rowcount1.Address Then Exit Do
                            FoundAt = FoundAt & ", " & rowcount.Address
                        Else
                            ExitLoop = True
                        End If
                    Loop
                End If
                    
            MyResult = MyResult & "Rank " & k & " is " & j & " in " & FoundAt & vbCr
        End If
Next k
MsgBox MyResult
End Sub
Currently my result in the message box looks like the following:

Rank 1 is 35 in $Q$7
Rank 2 is 32 in $Q$12, $Q$35
Rank 3 is 32 in $Q$12, $Q$35
Rank 4 is 29 in $Q$17, $Q$33, $Q$40
Rank 5 is 29 in $Q$17, $Q$33, $Q$40
Rank 6 is 29 in $Q$17, $Q$33, $Q$40
Rank 7 is 28 in $Q$13
Rank 8 is 27 in $Q$15
Rank 9 is 26 in $Q$36
Rank 10 is 23 in $Q$20

What I would ideally like is:

Rank 1 is 35 in $Q$7
Rank 2 is 32 in $Q$12
Rank 3 is 32 in $Q$35
Rank 4 is 29 in $Q$17
Rank 5 is 29 in $Q$33
Rank 6 is 29 in $Q$40
Rank 7 is 28 in $Q$13
Rank 8 is 27 in $Q$15
Rank 9 is 26 in $Q$36
Rank 10 is 23 in $Q$20

How would I go about only showing the address as linked to the ranked value and not the actual value?
I would really appreciate any help on this!!!
 

Mann750

Board Regular
Joined
Dec 16, 2009
Messages
72
Many thanks for your help venkat1926! Your macro works fine but ideally I need to adjust it so that outcome in columns 'D' and 'E' are not shown but are used for other calculations. I need to be able to extract a looked up value using the rank and row numbers and use them in another worksheet without having to introduce them to the worksheet, i.e. it all needs to be done 'behind the scenes' and the outcome in a messagebox, for example. How would modify the last part of your macro to do this?
 

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
It is not clar what exactly you want to dol

there are more than one way of solving the problem. yours is one way. mine is one. in my macro, mmax(1 to 10) and rrow(1 to 10) are numbers. so yoou can manipulate them. you can even copy these, instead of col D adn E in sheet 1, in another sheet and manipulate.
 

Mann750

Board Regular
Joined
Dec 16, 2009
Messages
72
Hi venkat1926, I have looked into your macro again and it seems that if I have duplicate values in the rank (or mmax) then the corresponding rrow is not found, just the first match. This is where my issue really lies...how can I get the macro to match the correct rrow to the mmax when there are duplicates? Again my results using your macro results in the following:

Rank 1 is 35 in row 7
Rank 2 is 32 in row 12
Rank 3 is 32 in row 12
Rank 4 is 29 in row 17
Rank 5 is 29 in row 17
Rank 6 is 29 in row 17
Rank 7 is 28 in row 13
Rank 8 is 27 in row 15
Rank 9 is 26 in row 36
Rank 10 is 23 in row 20
 

Mann750

Board Regular
Joined
Dec 16, 2009
Messages
72
I'm sorry venkat1926 but the link you provided does not answer my query. Your macro works fine for ranking the numbers correctly but all I need is to somehow modify the Match function so that the result is not the first cell found but the actual corresponding cell to the ranked score. In the code I posted above, the message box shows all the correct cell references but I would like it to show the correct reference to the corresponding score. How would I manipulate the code to do this instead of concatenating all the results together?

Code:
                If Not rowcount Is Nothing Then
                    Set rowcount1 = rowcount
                    FoundAt = rowcount.Address
                    Do While ExitLoop = False
                        Set rowcount = rngTestArea.FindNext(after:=rowcount)
                        If Not rowcount Is Nothing Then
                            If rowcount.Address = rowcount1.Address Then Exit Do
[COLOR=#ff0000]                            FoundAt = FoundAt & ", " & rowcount.Address
[/COLOR]                        Else
                            ExitLoop = True
                        End If
                    Loop
                End If
I think the line in red needs to be amended but not sure...please someone help!
 

Watch MrExcel Video

Forum statistics

Threads
1,090,306
Messages
5,413,684
Members
403,496
Latest member
chamshop

This Week's Hot Topics

Top