Rank the Minimum/Average Values in a Table with Duplicates

[studious]

I am trying to rank values in a table that has duplicate names:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Code[/TD]
[TD]Var1[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]1.5[/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]3.5[/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]333[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]333[/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]

The output should look like this:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Code[/TD]
[TD]Rank[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]333[/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]

Is there a clever way to do it instead of going through another table that takes the minimum/average for each unique 'Code' and then ranking these?

Thank you!

 

[decadence]

Perhaps this...

Sub RemoveDuplicates()
'
' Remove Duplicates Rows by Selecting Column
'
Dim R As Long
Dim N As Long
Dim V As Variant
Dim Rng As Range
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set Rng = Application.Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns(ActiveCell.Column))
Application.StatusBar = "Processing Row: " & Format(Rng.row, "#,##0")
N = 0
For R = Rng.Rows.Count To 2 Step -1
If R Mod 500 = 0 Then
    Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
End If
V = Rng.Cells(R, 1).Value
  If V = vbNullString Then
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
        Rng.Rows(R).EntireRow.Delete
        N = N + 1
    End If
  Else
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
        Rng.Rows(R).EntireRow.Delete
        N = N + 1
    End If
End If
Next R
EndMacro:
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

This will delete the duplicate rows based on the column you select. However it's not clear on what data you want to keep

 

[MickG]

Try this for results starting "D1"

[COLOR="Navy"]Sub[/COLOR] MG23Nov56
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dic.Add Dn.Value, Dn.Offset(, 1)
    [COLOR="Navy"]Else[/COLOR]
        Dic(Dn.Value) = Dic(Dn.Value) + Dn.Offset(, 1).Value
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Range("D1:E1").Value = Array("Code", "Var1")
 [COLOR="Navy"]Set[/COLOR] Rng = Range("D2").Resize(Dic.Count, 2)
    Rng.Value = Application.Transpose(Array(Dic.keys, Dic.items))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Columns(2).Cells
        Dn.Value = Application.Rank(Dn, Rng.Columns(2).Cells, 1)
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[MickG]

If you require the rankings results in same columns "A & B" then try this:-

[COLOR="Navy"]Sub[/COLOR] MG23Nov15
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dic.Add Dn.Value, Dn.Offset(, 1)
    [COLOR="Navy"]Else[/COLOR]
        Dic(Dn.Value).Value = Dic(Dn.Value) + Dn.Offset(, 1).Value
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Dn.Value = Application.Rank(Dn, Rng, 1)
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[studious]

Thanks! Great solutions, guys.

 

[Eric W]

Just for fun, here's a formula based solution:

	A	B	C	D	E

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]
[TD="bgcolor: #FAFAFA"]Code[/TD]
[TD="bgcolor: #FAFAFA"]Var1[/TD]
[TD="align: right"][/TD]
[TD="bgcolor: #FAFAFA"]Code[/TD]
[TD="bgcolor: #FAFAFA"]Rank[/TD]

[TD="align: center"]2[/TD]
[TD="bgcolor: #FAFAFA, align: right"]123[/TD]
[TD="bgcolor: #FAFAFA, align: right"]1[/TD]
[TD="align: right"][/TD]
[TD="bgcolor: #FAFAFA, align: right"]123[/TD]
[TD="bgcolor: #FAFAFA, align: right"]1[/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: #FAFAFA, align: right"]123[/TD]
[TD="bgcolor: #FAFAFA, align: right"]1.5[/TD]
[TD="align: right"][/TD]
[TD="bgcolor: #FAFAFA, align: right"]222[/TD]
[TD="bgcolor: #FAFAFA, align: right"]3[/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: #FAFAFA, align: right"]222[/TD]
[TD="bgcolor: #FAFAFA, align: right"]3[/TD]
[TD="align: right"][/TD]
[TD="bgcolor: #FAFAFA, align: right"]333[/TD]
[TD="bgcolor: #FAFAFA, align: right"]2[/TD]

[TD="align: center"]5[/TD]
[TD="bgcolor: #FAFAFA, align: right"]222[/TD]
[TD="bgcolor: #FAFAFA, align: right"]3.5[/TD]
[TD="align: right"][/TD]
[TD="bgcolor: #FAFAFA"][/TD]
[TD="bgcolor: #FAFAFA"][/TD]

[TD="align: center"]6[/TD]
[TD="bgcolor: #FAFAFA, align: right"]222[/TD]
[TD="bgcolor: #FAFAFA, align: right"]4[/TD]
[TD="align: right"][/TD]
[TD="bgcolor: #FAFAFA"][/TD]
[TD="bgcolor: #FAFAFA"][/TD]

[TD="align: center"]7[/TD]
[TD="bgcolor: #FAFAFA, align: right"]333[/TD]
[TD="bgcolor: #FAFAFA, align: right"]1[/TD]
[TD="align: right"][/TD]
[TD="bgcolor: #FAFAFA"][/TD]
[TD="bgcolor: #FAFAFA"][/TD]

[TD="align: center"]8[/TD]
[TD="bgcolor: #FAFAFA, align: right"]333[/TD]
[TD="bgcolor: #FAFAFA, align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="bgcolor: #FAFAFA"][/TD]
[TD="bgcolor: #FAFAFA"][/TD]

</tbody>

Sheet3​

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Array Formulas[TABLE="width: 100%"]
<thead>[TR="bgcolor: #DAE7F5"]
[TH="width: 10px"]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
</thead><tbody>[TR]
[TH="width: 10px, bgcolor: #DAE7F5"]D2[/TH]
[TD="align: left"]{=IF(D1="","",IFERROR(INDEX($A$2:$A$8,SMALL(IF(MATCH($A$2:$A$8,$A$2:$A$8,0)=ROW($A$2:$A$8)-ROW($A$2)+1,ROW($A$2:$A$8)-ROW($A$2)+1),ROWS($D$2:$D2))),""))}[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: #DAE7F5"]E2[/TH]
[TD="align: left"]{=IF(D2="","",SUM(IF(AVERAGEIF($A$2:$A$8,D2,$B$2:$B$8)>IF(MATCH($A$2:$A$8,$A$2:$A$8,0)=ROW($A$2:$A$8)-ROW($A$2)+1,AVERAGEIF($A$2:$A$8,$A$2:$A$8,$B$2:$B$8)),1))+1)}[/TD]
[/TR]
</tbody>[/TABLE]
Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}.
Note: Do not try and enter the {} manually yourself[/TD]
[/TR]
</tbody>[/TABLE]