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

#### Mann750

##### Board Regular
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!!!

### Excel Facts

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

#### venkat1926

##### Well-known Member
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
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
Do While ExitLoop = False
Set rowcount = rngTestArea.FindNext(after:=rowcount)
If Not rowcount Is Nothing Then
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
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
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
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

#### venkat1926

##### Well-known Member
see this webpage

 Ranking

<tbody>
</tbody>

#### Mann750

##### Board Regular
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
Do While ExitLoop = False
Set rowcount = rngTestArea.FindNext(after:=rowcount)
If Not rowcount Is Nothing Then
[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!