# select high value

###### Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Excel & VBA ExpertCommented:
Please give this a try...

In the attached, click the button called "Find Top 3" to run the code.

``````Sub getTop3()
Dim lr As Long, i As Long, j As Long, k As Long
Dim max1 As Long, max2 As Long, max3 As Long, maxIndex As Long, maxNum As Long
Dim num, x, dict, arrMax(), arr, r
lr = Cells(Rows.Count, "R").End(xlUp).Row
num = Range("R3:AA3").Value

x = Range("R3:AA" & lr).Value
Set dict = CreateObject("Scripting.Dictionary")

ReDim arr(1 To UBound(x, 1) - 1, 1 To 1)
For i = 2 To UBound(x, 1)
max1 = Application.Large(Application.Index(x, i, 0), 1)
max2 = Application.Large(Application.Index(x, i, 0), 2)
max3 = Application.Large(Application.Index(x, i, 0), 3)
For j = 1 To UBound(x, 2)
If x(i, j) = max1 Then
r = Application.Match(x(1, j), num, 0)
If Not IsError(r) Then
If r > maxIndex Then
maxIndex = r
maxNum = x(1, j)
End If
'End If
End If
End If
Next j
k = k + 1
ReDim Preserve arrMax(k)
arrMax(k) = maxNum
dict.Item(maxNum) = ""
maxIndex = 0

For j = 1 To UBound(x, 2)
If x(i, j) = max2 Then
r = Application.Match(x(1, j), num, 0)
If Not IsError(r) Then
If Not dict.exists(x(1, j)) Then
If r > maxIndex Then
maxIndex = r
maxNum = x(1, j)

End If
End If
End If
End If
Next j
k = k + 1
ReDim Preserve arrMax(k)
arrMax(k) = maxNum
dict.Item(maxNum) = ""
maxIndex = 0

For j = 1 To UBound(x, 2)
If x(i, j) = max3 Then
r = Application.Match(x(1, j), num, 0)
If Not IsError(r) Then
If Not dict.exists(x(1, j)) Then
If r > maxIndex Then
maxIndex = r
maxNum = x(1, j)
End If
End If
End If
End If
Next j
k = k + 1
ReDim Preserve arrMax(k)
arrMax(k) = maxNum
maxIndex = 0
arr(i - 1, 1) = Join(arrMax, "")
Erase arrMax
dict.RemoveAll
Next i
Range("J4").Resize(UBound(arr), 1).Value = arr

End Sub
``````
to_count_dta.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Older than dirtCommented:
Click the 'Top' button.
29115103.xlsm
ACCOUNTING ASSISTANTAuthor Commented:
Great JoB Best Expert !!
###### It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.