Retrive 1st, 2nd & 3rd highest & lowest value from the matrix data

R

rajamdade

New Member
Joined
Jun 14, 2014
Messages
35
Office Version
  1. 2016
Platform
  1. Windows
[TABLE="class: grid, width: 575"]
<tbody>[TR]
[TD][/TD]
[TD]GBCAT-1[/TD]
[TD]GBCAT-2[/TD]
[TD]GBCAT-3[/TD]
[TD]GBCAT-4[/TD]
[TD]GBCAT-5[/TD]
[TD]GBCAT-6[/TD]
[TD]GBCAT-7[/TD]
[TD]GBCAT-8[/TD]
[/TR]
[TR]
[TD]GBCAT-1[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0.226[/TD]
[TD="align: right"]0.234[/TD]
[TD="align: right"]0.216[/TD]
[TD="align: right"]0.248[/TD]
[TD="align: right"]0.205[/TD]
[TD="align: right"]0.201[/TD]
[TD="align: right"]0.196[/TD]
[/TR]
[TR]
[TD]GBCAT-2[/TD]
[TD="align: right"]0.226[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0.235[/TD]
[TD="align: right"]0.208[/TD]
[TD="align: right"]0.194[/TD]
[TD="align: right"]0.192[/TD]
[TD="align: right"]0.18[/TD]
[TD="align: right"]0.207[/TD]
[/TR]
[TR]
[TD]GBCAT-3[/TD]
[TD="align: right"]0.234[/TD]
[TD="align: right"]0.235[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0.21[/TD]
[TD="align: right"]0.249[/TD]
[TD="align: right"]0.205[/TD]
[TD="align: right"]0.203[/TD]
[TD="align: right"]0.184[/TD]
[/TR]
[TR]
[TD]GBCAT-4[/TD]
[TD="align: right"]0.216[/TD]
[TD="align: right"]0.208[/TD]
[TD="align: right"]0.21[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0.195[/TD]
[TD="align: right"]0.17[/TD]
[TD="align: right"]0.168[/TD]
[TD="align: right"]0.193[/TD]
[/TR]
[TR]
[TD]GBCAT-5[/TD]
[TD="align: right"]0.248[/TD]
[TD="align: right"]0.194[/TD]
[TD="align: right"]0.249[/TD]
[TD="align: right"]0.195[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0.212[/TD]
[TD="align: right"]0.199[/TD]
[TD="align: right"]0.188[/TD]
[/TR]
[TR]
[TD]GBCAT-6[/TD]
[TD="align: right"]0.205[/TD]
[TD="align: right"]0.192[/TD]
[TD="align: right"]0.205[/TD]
[TD="align: right"]0.17[/TD]
[TD="align: right"]0.212[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0.05[/TD]
[TD="align: right"]0.125[/TD]
[/TR]
[TR]
[TD]GBCAT-7[/TD]
[TD="align: right"]0.201[/TD]
[TD="align: right"]0.18[/TD]
[TD="align: right"]0.203[/TD]
[TD="align: right"]0.168[/TD]
[TD="align: right"]0.199[/TD]
[TD="align: right"]0.05[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0.127[/TD]
[/TR]
[TR]
[TD]GBCAT-8[/TD]
[TD="align: right"]0.196[/TD]
[TD="align: right"]0.207[/TD]
[TD="align: right"]0.184[/TD]
[TD="align: right"]0.193[/TD]
[TD="align: right"]0.188[/TD]
[TD="align: right"]0.125[/TD]
[TD="align: right"]0.127[/TD]
[TD="align: right"]0[/TD]
[/TR]
</tbody>[/TABLE]

I am having huge data (4000x4000) the above data is sample of it, I need to find and retrive 1st, 2nd and 3rd highest and lowest values returning their column and row names as below:

[TABLE="class: grid, width: 1091"]
<tbody>[TR]
[TD]Find 1st highest[/TD]
[TD="align: right"]0.249[/TD]
[TD][/TD]
[TD]Find 2nd highest[/TD]
[TD="align: right"]0.248[/TD]
[TD][/TD]
[TD]Find 3rd highest[/TD]
[TD="align: right"]0.235[/TD]
[TD][/TD]
[TD]Find 1st lowest[/TD]
[TD="align: right"]0[/TD]
[TD][/TD]
[TD]Find 2nd lowest[/TD]
[TD="align: right"]0.05[/TD]
[TD][/TD]
[TD]Find 3rd lowest[/TD]
[TD="align: right"]0.125[/TD]
[/TR]
[TR]
[TD]GBCAT-3[/TD]
[TD]GBCAT-5[/TD]
[TD][/TD]
[TD]GBCAT-1[/TD]
[TD]GBCAT-5[/TD]
[TD][/TD]
[TD]GBCAT-2[/TD]
[TD]GBCAT-3[/TD]
[TD][/TD]
[TD]GBCAT-1[/TD]
[TD]GBCAT-1[/TD]
[TD][/TD]
[TD]GBCAT-6[/TD]
[TD]GBCAT-7[/TD]
[TD][/TD]
[TD]GBCAT-6[/TD]
[TD]GBCAT-8[/TD]
[/TR]
[TR]
[TD]GBCAT-5[/TD]
[TD]GBCAT-3[/TD]
[TD][/TD]
[TD]GBCAT-5[/TD]
[TD]GBCAT-1[/TD]
[TD][/TD]
[TD]GBCAT-3[/TD]
[TD]GBCAT-2[/TD]
[TD][/TD]
[TD]GBCAT-2[/TD]
[TD]GBCAT-2[/TD]
[TD][/TD]
[TD]GBCAT-7[/TD]
[TD]GBCAT-6[/TD]
[TD][/TD]
[TD]GBCAT-8[/TD]
[TD]GBCAT-6[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]GBCAT-3[/TD]
[TD]GBCAT-3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]GBCAT-4[/TD]
[TD]GBCAT-4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]GBCAT-5[/TD]
[TD]GBCAT-5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]GBCAT-6[/TD]
[TD]GBCAT-6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]GBCAT-7[/TD]
[TD]GBCAT-7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]GBCAT-8[/TD]
[TD]GBCAT-8[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Any kind of help, formula else script will be appereciated, thank you!
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Sort by date Sort by votes
Try this:-
NB:- Data = sheet1, Results sheet2
Code: 
[COLOR=Navy]Sub[/COLOR] MG21Jun11
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] oSz         [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] oMax        [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] c           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] R           [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Col         [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] nMax        [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
c = 1

Set Rng = Sheets("Sheet1").Range("A1").CurrentRegion 
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Not Dn.Row = 1 And Not Dn.Column = 1 [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
            .Add Dn.Value, Dn
        [COLOR=Navy]Else[/COLOR]
            [COLOR=Navy]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
        oMax = Application.Max(.Item(Dn.Value).Count)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]

ReDim Ray(1 To Rng.Rows.Count, 1 To 20)
Ray(1, 1) = "Find 1st highest": Ray(1, 4) = "Find 2nd highest": Ray(1, 7) = "Find 3rd highest"
Ray(1, 10) = "Find 1st Lowest": Ray(1, 13) = "Find 2nd Lowest": Ray(1, 16) = "Find 3rd Lowest "
[COLOR=Navy]For[/COLOR] oSz = 1 To 3
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] .Item(Application.Large(.keys, oSz))
            [COLOR=Navy]Select[/COLOR] [COLOR=Navy]Case[/COLOR] oSz
                [COLOR=Navy]Case[/COLOR] 1: Col = 1
                [COLOR=Navy]Case[/COLOR] 2: Col = 4
                [COLOR=Navy]Case[/COLOR] 3: Col = 7
            [COLOR=Navy]End[/COLOR] Select
            Ray(1, Col + 1) = Application.Large(.keys, oSz)
            c = c + 1
            Ray(c, Col) = Cells(R.Row, 1)
            Ray(c, Col + 1) = Cells(1, R.Column)
            [COLOR=Navy]Next[/COLOR] R
            nMax = Application.Max(nMax, c)
            c = 1
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] .Item(Application.Small(.keys, oSz))
            [COLOR=Navy]Select[/COLOR] [COLOR=Navy]Case[/COLOR] oSz
                [COLOR=Navy]Case[/COLOR] 1: Col = 10
                [COLOR=Navy]Case[/COLOR] 2: Col = 13
                [COLOR=Navy]Case[/COLOR] 3: Col = 16
            [COLOR=Navy]End[/COLOR] Select
            Ray(1, Col + 1) = Application.Small(.keys, oSz)
            c = c + 1
            Ray(c, Col) = Cells(R.Row, 1)
            Ray(c, Col + 1) = Cells(1, R.Column)
            [COLOR=Navy]Next[/COLOR] R
            nMax = Application.Max(nMax, c)
            c = 1
[COLOR=Navy]Next[/COLOR] oSz
[COLOR=Navy]End[/COLOR] With
Sheets("Sheet2").Range("A1").Resize(nMax, 20) = Ray
MsgBox "run"
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thank you MickG ! thanks for the code, it works perfectly for small data. When i run for large data the excel ends up with error 'Not Responding'. Further i need to kill the process, is there anything to do!

Otherwise pls edit code to find only highest and lowest value.
Looking forward for response, regards!
 
Upvote 0
On reflection of your thread, I think 4000 x 4000 loops would be quite a lot to ask !!!
As requested the code below is for Just "Highest & lowest", Results sheet3.
Code: 
[COLOR=Navy]Sub[/COLOR] MG22Jun37
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] oSz         [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] oMax        [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] c           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] R           [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Col         [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] nMax        [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
c = 1


Set Rng = Sheets("Sheet1").Range("A1").CurrentRegion
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Not Dn.Row = 1 And Not Dn.Column = 1 [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
            .Add Dn.Value, Dn
        [COLOR=Navy]Else[/COLOR]
            [COLOR=Navy]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
        oMax = Application.Max(.Item(Dn.Value).Count)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
ReDim Ray(1 To Rng.Rows.Count, 1 To 5)
Ray(1, 1) = "Find highest"
Ray(1, 4) = "Find Lowest"
[COLOR=Navy]For[/COLOR] oSz = 1 To 3
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] .Item(Application.Max(.keys))
            Ray(1, 2) = Application.Max(.keys)
            c = c + 1
            Ray(c, 1) = Cells(R.Row, 1)
            Ray(c, 2) = Cells(1, R.Column)
            [COLOR=Navy]Next[/COLOR] R
            nMax = Application.Max(nMax, c)
            c = 1
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] .Item(Application.Min(.keys))
            Ray(1, 5) = Application.Min(.keys)
            c = c + 1
            Ray(c, 4) = Cells(R.Row, 1)
            Ray(c, 5) = Cells(1, R.Column)
            [COLOR=Navy]Next[/COLOR] R
            nMax = Application.Max(nMax, c)
            c = 1
[COLOR=Navy]Next[/COLOR] oSz
[COLOR=Navy]End[/COLOR] With
Sheets("Sheet3").Range("A1").Resize(nMax, 5) = Ray
MsgBox "run"
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
This code should be a lot Faster, although its not been tested on a large data set.
Nb:- Data sheet1, Results sheet3.
Code: 
[COLOR=Navy]Sub[/COLOR] MG22Jun46
[COLOR=Navy]Dim[/COLOR] c           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] R           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] nMax        [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Ac          [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] nRay        [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Rmax        [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Cmax        [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Rmin        [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Cmin        [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Q           [COLOR=Navy]As[/COLOR] Variant
c = 1
nRay = Sheets("Sheet2").Range("A1").CurrentRegion
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] Ac = 2 To UBound(nRay, 1)
[COLOR=Navy]For[/COLOR] n = 2 To UBound(nRay, 1)
        [COLOR=Navy]If[/COLOR] Not .Exists(nRay(n, Ac)) [COLOR=Navy]Then[/COLOR]
            .Add nRay(n, Ac), Array(n, Ac)
        [COLOR=Navy]Else[/COLOR]
           Q = .Item(nRay(n, Ac))
           Q(0) = Q(0) & "," & n
           Q(1) = Q(1) & "," & Ac
           .Item(nRay(n, Ac)) = Q
       [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]Next[/COLOR] Ac

ReDim ray(1 To UBound(nRay, 1) + 1, 1 To 5)
ray(1, 1) = "Find highest"
ray(1, 4) = "Find Lowest"

Rmax = Split(.Item(Application.Max(.keys))(0), ",")
Cmax = Split(.Item(Application.Max(.keys))(1), ",")
Rmin = Split(.Item(Application.Min(.keys))(0), ",")
Cmin = Split(.Item(Application.Min(.keys))(1), ",")
 
 ray(1, 2) = Application.Max(.keys)
 ray(1, 5) = Application.Min(.keys)
        [COLOR=Navy]For[/COLOR] R = 0 To UBound(Rmax)
            c = c + 1
            ray(c, 1) = nRay(Rmax(R), 1)
            ray(c, 2) = nRay(1, Cmax(R))
        [COLOR=Navy]Next[/COLOR] R
            nMax = Application.Max(nMax, c)
            c = 1
        [COLOR=Navy]For[/COLOR] R = 0 To UBound(Rmin)
            c = c + 1
            ray(c, 4) = nRay(Rmin(R), 1)
            ray(c, 5) = nRay(1, Cmin(R))
        [COLOR=Navy]Next[/COLOR] R
            nMax = Application.Max(nMax, c)
            c = 1
[COLOR=Navy]End[/COLOR] With
Sheets("Sheet3").Range("A1").Resize(nMax, 5) = ray
MsgBox "Run"
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Thanks for giving your time MickG. When code was executed, it gave an error message 'Run time error:13, Type mismatch' on,
Line 17.......
'For Ac = 2 To UBound(nRay, 1)'

Please suggest a possible solution!
Regards,
rajamdade
 
Upvote 0
Above that line you will see
Code: 
nRay = Sheets("Sheet2").Range("A1").CurrentRegion

This shows the code is looking at data on sheet 2,
Maybe you data is in sheet 1, as previous code.
If so change the 2 to a 1.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Extract columns and copy to separate worksheet
Replies
9
Views
558
AndyMcC
A
S
  • Question Question
Need help with Data in Subgroup
Replies
4
Views
397
sksanjeev786
S
E
  • Solved
formula to return two columns of data adjacent to #N/A cell entry
Replies
3
Views
367
Fluff
Fluff
K
  • Solved
Lookup Data from Vertical to Horizontal
Replies
5
Views
1K
alansidman
A
R
  • Question Question
Calculate Percentage for matrix data
Replies
4
Views
557
rajamdade
R

Forum statistics

Threads
1,223,911
Messages
6,175,329
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top