VBA issue: Sumproduct & index and match - multiple criteria

Hi,

I have tried to solve the following issue without any luck - not even from the help of my professor, so therefore I hope someone in here can help me.
I want to make a lookup based on two criteria and then return a value dependent on these criteria. It should be noted that I know how to solved this issue in various different ways, but now I'm just curious to find a solution using 3 different approaches that I WANT to work, but currently do not which causes my frustration.

I want to make a loop going through cells 3,3 to 6,3 ultimately, but that is not the important thing here. Therefore I have just written the codes so that cell 3,3 should be able to return the correct value.

I have made the 3 possibile ways to solve this issue using manual formulas inside the sheet in columns I,J and K. It is these formulas that I want to implement inside VBA. This also means that for instance I do not want a solution that "pastes" formula inside the sheet so the solution has to be made inside vba.

Hope anyone can help meAttachment 10616Attachment 10616

For these type of functions (array functions) you cannot use the normal approach, but you have to build an Excel function (identical to what would be in a cell) and then use Application.Evaluate(your function) to get the result.

I have done it for one of your functions here, I have used a seperate function for clarity.

Code:

---

Option Explicit



Private Const TEMPLATE As String = "=INDEX({0},MATCH(1,({1}={2})*({3}={4}),{5}))"
Private Const MATCH_TYPE = 0


Sub MatchName()
    Dim NameValue As Range, DateValuea As Range, ReturnRange As Range
    Dim a As Variant
    Dim s As Worksheet
   
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    ActiveSheet.DisplayPageBreaks = False
   
   
   
    Set s = Worksheets("test")
   
    'Dim namevalue As Range
    'Dim DateValuea As Range
    'Dim returnrange As Range
   
    Set NameValue = Range(s.Cells(3, 5), s.Cells(6, 5))
    Set DateValuea = Range(s.Cells(3, 6), s.Cells(6, 6))
    Set ReturnRange = Range(s.Cells(3, 7), s.Cells(6, 7))
   
   
   
   
'    On Error Resume Next
   
    'solution styles
    With Application.WorksheetFunction
   
        ' Solution option 1
        'ReturnRange, Application.WorksheetFunction.match(1, ((s.Cells(3, 1) = NameValue) * (s.Cells(3, 2)) = DateValuea), 0)
        '  =INDEX({0},MATCH(1,({1}={2})*({3}={4}),{5}))
        s.Cells(3, 3) = IndexMatch1(ReturnRange, NameValue, s.Cells(3, 1), DateValuea, s.Cells(3, 2))
       
        ' Solution option 2
''        s.Cells(3, 3) = .IfError(.Index(ReturnRange, .match(s.Cells(3, 1) & s.Cells(3, 2), NameValue & DateValuea, 0), 0), "")
''
''        ' Solution option 3
''        s.Cells(3, 3) = .SumProduct((NameValue = s.Cells(3, 1)) * (DateValuea = s.Cells(3, 2)) * ReturnRange)
''
''        ' match funktioner virker heller ikke
''        a = .match(s.Cells(3, 1) & s.Cells(3, 2), NameValue & DateValuea, 0)
''        a = .match(1, (s.Cells(3, 1) = NameValue) * (s.Cells(3, 2) = DateValuea), 0)
    End With


End Sub


Public Function IndexMatch1(ByRef outputRange As Range, _
                                ByRef nameCriteria As Range, _
                                ByRef nameRange As Range, _
                                ByRef dateCriteria As Range, _
                                ByRef dateRange As Range)
    Dim myFormula As String
    Dim originalReferenceStyle


    On Error GoTo Err_Handler
    Err.Number = 0
    originalReferenceStyle = Application.ReferenceStyle
    Application.ReferenceStyle = xlR1C1
'  =INDEX({0},MATCH(1,({1}={2})*({3}={4}),{5}))


    myFormula = Replace(TEMPLATE, "{0}", outputRange.Address())
    myFormula = Replace(myFormula, "{1}", nameCriteria.Address())
    myFormula = Replace(myFormula, "{2}", nameRange.Address())
    myFormula = Replace(myFormula, "{3}", dateCriteria.Address())
    myFormula = Replace(myFormula, "{4}", dateRange.Address())
    myFormula = Replace(myFormula, "{5}", MATCH_TYPE)


    IndexMatch1 = Application.Evaluate(myFormula)


Err_Handler:
    If (Err.Number <> 0) Then MsgBox Err.Description
    Application.ReferenceStyle = originalReferenceStyle
End Function

---

Forgot to say why it doesn't work normally: When you use an array function in Excel (or with the Evaluate procedure) then Excel understands you are using array functions and so the sub results of the various parameters are arrays themselves. But if you have

Code:

---

        ' Solution option 3
        s.Cells(3, 3) = .SumProduct((NameValue = s.Cells(3, 1)) * (DateValuea = s.Cells(3, 2)) * ReturnRange)

---

then then individual parameters are being calculated as a normal value before being passed to the SumProduct function, so the SumProduct function never sees arrays.

You could do it differently by building the arrays and passing these to SumProduct (or Match etc) as described by Andrew Poulson in mrexcel.com/forum/excel-questions/47370-sumproduct-visual-basic-applications.html

Code:

---

Function xxx(x, y)
    Dim WF As WorksheetFunction
    Dim a As Range, b As Range, c As Range
    Dim Arr1 As Variant, Arr2 As Variant, Arr3 As Variant
    Dim i As Integer
    Set WF = Application.WorksheetFunction
    Set a = Range("A4:A14")
    Set b = Range("B4:B14")
    Set c = Range("C4:C14")
    Arr1 = WF.Transpose(a)
    For i = 1 To UBound(Arr1)
        If Arr1(i) = x Then
            Arr1(i) = 1
        Else
            Arr1(i) = 0
        End If
    Next i
    Arr2 = WF.Transpose(b)
    For i = 1 To UBound(Arr2)
        If Arr2(i) = y Then
            Arr2(i) = 1
        Else
            Arr2(i) = 0
        End If
    Next i
    Arr3 = WF.Transpose(c)
    xxx = WF.SumProduct(Arr1, Arr2, Arr3)
End Function

---

Some further pointers for better coding:

Do use Dim variables. I don't understand why you had commented them out
Don't use On Error Resume Next
unless there is good reason (such as when testing if file is open). If you do use it cancel it as quickly as possible when it is no longer required (On Error goto 0)
Don't use variable names or sub / function names which are similar or the same as Excel function names. Your sub was called match(). So how can you start confusing Excel and yourself more?