0

Please have a look at the following given code. It does the work but the code gives the values including the duplicates. (see the output)

I couldn't figure out how to extract unique vales instead of duplicates.

 S.No   Values
 1      99.501
 2      99.441
 3      99.346
 4      99.683
 5      99.683
 6      99.941
 7      99.326
 8      99.315
 9      99.326
10      99.564
11      99.565
12      99.513
13      99.396
14      99.676
15      99.083
16      99.083
17      98.886
18      99.129
19      99.129
20      99.73

My code:

Sub MaxMin()

    Dim Rng As Range, Dn As Range, Lg As String
    Dim n As Long, c As Long, nRay As Variant
    Dim Sm As String, Sp As Variant, ac As Long
    Dim col As Integer, R As Long, t
    Set Rng = Range(Range("b2"), Range("b" & Rows.Count).End(xlUp))
    For n = 1 To 5
        Lg = Lg & IIf(Lg = "", Application.Large(Rng, n), "," _
                        & Application.Large(Rng, n))
        Sm = Sm & IIf(Sm = "", Application.Small(Rng, n), "," _ 
                        & Application.Small(Rng, n))
    Next n
    Sp = Array(Split(Lg, ","), Split(Sm, ","))
    ReDim Ray(1 To 11, 1 To 4)
    Ray(1, 1) = "S.No"
    Ray(1, 2) = "Max"
    Ray(1, 3) = "S.No"
    Ray(1, 4) = "Min"
    For ac = 0 To 1
        col = IIf(ac = 0, 1, 3)
        c = 0
        nRay = Range(Range("A2"), Range("b" & Rows.Count).End(xlUp)).Resize(, 2)
        c = 1
        For n = 0 To 4
            For R = 1 To UBound(nRay, 1)
                If Not IsEmpty(nRay(R, 2)) And nRay(R, 2) = Val(Sp(ac)(n)) Then
                    c = c + 1
                    Ray(c, col) = nRay(R, 1)
                    Ray(c, col + 1) = nRay(R, 2)
                    nRay(R, 2) = ""
                    Exit For
                End If
            Next R
        Next n
    Next ac
    Range("F1").Resize(6, 4).Value = Ray
End Sub

Output:

S.No    Max     S.No    Min
6       99.941  17      98.886
20      99.73   15      99.083
4       99.683  16      99.083
5       99.683  18      99.129
14      99.676  19      99.129

The modified code should not include "duplicate" only "unique" 5 max and 5 min values with their index positions.

Community
  • 1
  • 1
Hola
  • 95
  • 4
  • 15
  • 1
    I usually use a dictionary to filter for unique values though i am sure there are other ways. Can you order the data first and then add to a dictionary? Or use VBA SQL query where you Union a Select Distinct Top 5 Order By Asc and Select Distinct Top 5 Order By Desc? Need With ties specified [example with top](https://stackoverflow.com/questions/887787/access-sql-using-top-5-returning-more-than-5-results) , [example with distinct](https://stackoverflow.com/questions/23345176/how-to-select-distinct-values-from-one-column-in-adodb-recordset-excel-vba) – QHarr Dec 26 '17 at 09:04
  • Possible duplicate of [Getting unique values in Excel by using formulas only](https://stackoverflow.com/questions/1429899/getting-unique-values-in-excel-by-using-formulas-only) – ashleedawg Dec 26 '17 at 09:36

1 Answers1

3

You can use Dictionary Object to get such results which QHarr is referring to like below.

Public Sub GetMinMax()
Dim objDict As Object
Dim i As Long
Set objDict = CreateObject("Scripting.Dictionary")
'\\ Add uniques to list
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
    If Not objDict.exists(Range("B" & i).Value) Then objDict.Add Range("B" & i).Value, Range("A" & i).Value
Next
'\\ Populate output columns
Range("F1").Resize(1, 4).Value = Array("S.No.", "Max", "S.No.", "Min")
For i = 1 To 5
    Range("G" & i + 1).Value = Application.Large(objDict.keys, i)
    Range("F" & i + 1).Value = objDict.Item(Range("G" & i + 1).Value)
    Range("I" & i + 1).Value = Application.Small(objDict.keys, i)
    Range("H" & i + 1).Value = objDict.Item(Range("I" & i + 1).Value)
Next
End Sub
shrivallabha.redij
  • 5,832
  • 1
  • 12
  • 27