Extract lowest value from data set

[Russ At Index]

Hi Excellers ...
I wonder if anyone can assist .
I have a data set that contains product code and a cost associated with that code.Column A & B
The issue i have is , for some reason there are more than one cost attached to each code ( weird )
Eg
Code
1234 £1.99
1234 £2.99
222 £3.99
3456 £14.99
3456 £12.99
I would like to report the lowest cost against each code , is there any way Excel can perform this task ?.

Thanks in advance ,

Russ

 

[mumps]

Assuming you have headers in row 1 and the data starts in row 2, try:

Sub FindLowestVal()
    Application.ScreenUpdating = False
    Dim i As Long, v1 As Variant, item As Variant, rngList As Object, rng As Range
    v1 = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
    Set rngList = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v1, 1)
        If Not rngList.Exists(v1(i, 1)) Then
            rngList.Add v1(i, 1), Nothing
        End If
    Next i
    For Each item In rngList
        With Range("A1").CurrentRegion
            .AutoFilter 1, item
            For Each rng In Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
                If rng = WorksheetFunction.Min(Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)) Then
                    rng.Interior.ColorIndex = 3
                End If
            Next rng
            .AutoFilter
        End With
    Next item
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Another option

Sub RussAtIndex()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .Exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, 1).Value
         ElseIf Cl.Offset(, 1).Value < .Item(Cl.Value) Then
            .Item(Cl.Value) = Cl.Offset(, 1).Value
         End If
      Next Cl
      Range("D1").Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
   End With
End Sub

 

[Rick Rothstein]

Another option

Sub RussAtIndex()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .Exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, 1).Value
         ElseIf Cl.Offset(, 1).Value < .Item(Cl.Value) Then
            .Item(Cl.Value) = Cl.Offset(, 1).Value
         End If
      Next Cl
      Range("D1").Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
   End With
End Sub

I have no idea if this is more efficient or not, but here is a slight modification to your code which should also work...

[table="width: 500"]
[tr]
	[td]Sub RussAtIndex2()
   Dim LastRow As Long, Cl As Range
   LastRow = Range("A" & Rows.Count).End(xlUp).Row
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2:A" & LastRow)
         If Not .Exists(Cl.Value) Then .Add Cl.Value, Evaluate(Replace("MIN(IF(A2:A#=" & Cl.Value & ",B2:B#))", "#", LastRow))
      Next
      Range("D1").Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
   End With
End Sub[/td]
[/tr]
[/table]

 

[Doflamingo]

Hi Fluff and Rick,

I've tried your code and it doesn't work properly

That's weird because for instance in the column E, for the code of 1234 it put the highest value which is 2.99 and not 1, 99 while for the code 3456 it gives the lowest value like wanted which is 12,99 and not 14,99.

Any ideas ?

 

[Doflamingo]

Actually it works, if you put add a row, which means when you run the code there is nothing in the row 1

 

[Doflamingo]

Hi Fluff and Rick,

I've tried your code and it doesn't work properly

That's weird because for instance in the column E, for the code of 1234 it put the highest value which is 2.99 and not 1, 99 while for the code 3456 it gives the lowest value like wanted which is 12,99 and not 14,99.

Any ideas ?

 

[Fluff]

Check your numbers

 

[Doflamingo]

My mistake, it works perfectly

 

[Russ At Index]

Many thanks Guys , apologies for the lateness in in the reply .
Have a good Day,
Russ.