Hello Douglas,
Thanks for the feedback on this. I have corrected the macro to update the Supplier when the minimum Price is found. If a Price is zero it will be ignored. Here is the updated macro and workbook.
Macro Code Version 2
Option Explicit
Sub MinPriceBySupplier()
Dim Data As Variant
Dim Dict As Object
Dim Item As Variant
Dim j As Long
Dim nSerial As Long
Dim Rng As Range
Dim RngBeg As Range
Dim RngEnd As Range
Dim vaEAN As Variant
Dim vaPrice As Variant
Dim vaSupplier As Variant
Dim Wks As Worksheet
Set Wks = ThisWorkbook.ActiveSheet
Set RngBeg = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
If RngEnd.Row < RngBeg.Row Then Exit Sub
' Clear any previous output data.
With Wks.Range("E1").CurrentRegion
Set Rng = Intersect(.Cells, .Cells.Offset(1, 0))
If Not Rng Is Nothing Then Rng.ClearContents
End With
Set Dict = CreateObject("Scripting.Dictionary")
Dict.CompareMode = vbTextCompare
' Load the arrays with their respective column data.
With Wks.Range(RngBeg, RngEnd)
vaEAN = .Value
vaPrice = .Offset(0, 2).Value
vaSupplier = .Offset(0, 1).Value
End With
' Identify the unique EAN numbers.
For j = 1 To UBound(vaEAN, 1)
Item = Trim(vaEAN(j, 1))
If Item <> "" Then
If Not Dict.Exists(Item) Then
nSerial = nSerial + 1
Dict.Add Item, nSerial
End If
End If
Next j
' Size the Data array to hold the output values.
ReDim Data(1 To nSerial, 1 To 3)
' Load the output data into the Data array and save the lowest price.
For j = 1 To UBound(vaEAN, 1)
Item = Trim(vaEAN(j, 1))
If Dict.Exists(Item) Then
nSerial = Dict(Item)
If Data(nSerial, 1) = Empty Then
Data(nSerial, 1) = vaEAN(j, 1)
Data(nSerial, 2) = vaPrice(j, 1)
Data(nSerial, 3) = vaSupplier(j, 1)
Else
If vaPrice(j, 1) <> 0 Then
If Data(nSerial, 2) = 0 Then
Data(nSerial, 2) = vaPrice(j, 1)
Data(nSerial, 3) = vaSupplier(j, 1)
End If
If vaPrice(j, 1) < Data(nSerial, 2) Then
Data(nSerial, 2) = vaPrice(j, 1)
Data(nSerial, 3) = vaSupplier(j, 1)
End If
End If
End If
End If
Next j
' Output the Data array as a contiguous range of nSerial rows by 3 columns wide.
Wks.Range("E2").Resize(nSerial, 3).Value = Data
End Sub