Alternatives to MINIFS (Minimum IF's)

[D_Marcel]

I've started with Office 2016 about a month ago but I've heard several people comenting about new features in Excel already. One of these features is the very useful function MINIFS, that's returns the minimal value based on multiple criteria.
The version instaled in my office notebook, however, is 2013.

I've googled about alternatives and found that in previous versions you can use MIN + IF as an array formula to get the same results. I had never used array formulae before and I found that they are very much slow to calculate than a regular formula. As I have to use an array formula to more than four hundred thousand cells in my current demand, I fell in a serious performance challenge (I'm testing right now, it's running for 80 minutes with 45% of conclusion).

I'm sharing a sample of what I'm using.
An very important detail is that my main condition is getting the minimal value different of zero.

Is there an faster alternative? If not, I'll use "Application.OnTime" to run it dawn.
Thanks for any help and comment!

[Bob Phillips]

I can't think of a faster formula equivalent. Formulas aren't really made to analyse 400K cells!

I did try to think of a solution using Power Query, but nothing has occurred yet.

But the obvious answer is ... pivot tables. Pivot your data and set the value field setting to Min. To ignore zeros, add a helper column with a formula of =C2>0 and include that in your row pane.

[Leith Ross]

Hello D_Marcel,

Here is a VBA macro solution. This has a button to run the macro. This should work very quickly. Give it try and let me know the results.



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 Data(nSerial, 2) <> 0 Then
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

[D_Marcel]

@xld
I agree! I'm trying to get access to MS Access, guess that probably would be better to all these massive data manipulations. Pivot Tables are really faster, I'm gonna try your suggestion.

@Ross
Amazing! :wot

I've tested and there's just a few adjustments that we need to do. I was trying to set the perfect algorythm but unfortuntely I didn't figure out yet:

1. The code do not ignores zeros. To EAN code 7891000100200 for example, if the last value is zero, this one will be the lowest price.
2. If the first occurrence to Data(nSerial, 2) is zero, all the other values will be ignored:

If Data(nSerial, 2) <> 0 Then
If vaPrice(j, 1) < Data(nSerial, 2) Then Data(nSerial, 2) = vaPrice(j, 1)
End If

So, I'm trying to figure out a way to test all the occurrences, even that the first one is zero, and also ignore zeros.

Thank you, very very much! I'm pretty sure that this solution will be extremely useful in my job.

Kinds regards,

Douglas

[D_Marcel]

I forgot another point:

3. When the array is loaded to the range:

Wks.Range("E2").Resize(nSerial, 3).Value = Data

It always returns the first occurrence to SUPPLIER, and not the one corresponding to the lowest price found.

This is my hundredth post and now I'm VBAX Contributor! :biggrin:

[Leith Ross]

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

[D_Marcel]

Hello Leith!
I've just tested the new version and it works PERFECTLY now!
I'll create a function with this algorythm to call it from my subroutines. Words are not enough to thank you for this help. Hope I can retribute somehow here in the forum.

With the best regards,

Douglas

[Leith Ross]

Hello Douglas,

It is always nice to get good news. Glad I could help out.