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!

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:

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

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:

[VBA]Wks.Range("E2").Resize(nSerial, 3).Value = Data[/VBA]

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!

[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.