select high value

selct the top repeat digit
as  show here
a55.PNGto_count_dta.xlsx
ADRIANA PACCOUNTING ASSISTANTAsked:
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.

Subodh Tiwari (Neeraj)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

Open in new window

to_count_dta.xlsm
0

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.

Start your 7-day free trial
Martin LissOlder than dirtCommented:
Click the 'Top' button.
29115103.xlsm
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Great JoB Best Expert !!
1
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.