Extract unique list based on criteria and priority level

[alpha2018]

Hi there,

I am trying to get excel to extract a unique list based on criteria and priority level. I managed to get the list extracted based on criteria but I don't know how to sort them so they are pulled in order based on their priority level. I'd appreciate any help! Excel sheet is attached.


Excel sheet here: https://ufile.io/vj15e

 

[MickG]

Try this for results starting "H1"
NB:- Assumed the Word Category in you data starts in "A1".

[COLOR="Navy"]Sub[/COLOR] MG02Mar50
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] I, J, Col1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Col2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[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 .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            ReDim Ray(1 To 2, 1 To 1)
            Ray(1, 1) = Dn.Offset(, 1).Value
            Ray(2, 1) = Dn.Offset(, 2).Value
        .Add Dn.Value, Ray
    [COLOR="Navy"]Else[/COLOR]
     Q = .Item(Dn.Value)
        ReDim Preserve Q(1 To 2, 1 To UBound(Q, 2) + 1)
            Q(1, UBound(Q, 2)) = Dn.Offset(, 1).Value
            Q(2, UBound(Q, 2)) = Dn.Offset(, 2).Value
    .Item(Dn.Value) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Ac = 7
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
Q = .Item(K)
[COLOR="Navy"]For[/COLOR] I = 1 To UBound(Q, 2)
    [COLOR="Navy"]For[/COLOR] J = I To UBound(Q, 2)
       [COLOR="Navy"]If[/COLOR] Val(Q(2, J)) < Val(Q(2, I)) [COLOR="Navy"]Then[/COLOR]
            Col1 = Q(1, I)
            Col2 = Q(2, I)
                Q(1, I) = Q(1, J)
                Q(2, I) = Q(2, J)
                    Q(1, J) = Col1
                   Q(2, J) = Col2
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] J
[COLOR="Navy"]Next[/COLOR] I
    .Item(K) = Q
    Ac = Ac + 1
    Cells(1, Ac) = K
    Cells(2, Ac).Resize(UBound(.Item(K), 2), 1) = Application.Index(Application.Transpose(.Item(K)), _
    Evaluate("Row(1:" & UBound(.Item(K), 2) & ")"), 0)
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[kvsrinivasamurthy]

Your data in B2:D7
ARRAY formula in H2, then drag across.

=IFERROR(INDEX($C$2:$C$7,SMALL(IF((($B$2:$B$7=H$1)*(($D$2:$D$7)+(ROW($B$2:$B$7))*10^-6))=SMALL(IF($B$2:$B$7=H$1,($D$2:$D$7)+(ROW($B$2:$B$7))*10^-6,""),ROWS($H$2:$H2)),ROW($B$2:$B$7),""),1)-ROW($B$2)+1),"")

ARRAY formula is used


To enter ARRAY formula
Paste the formula
Press F2
Press Ctrl+Shift+Enter keys together.
formula will be covered with{} brackets by excel.