Consulting

Results 1 to 4 of 4

Thread: VBA issue: Sumproduct & index and match - multiple criteria

  1. #1

    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 meMatch.xlsmMatch.xlsm

  2. #2
    VBAX Regular
    Joined
    Sep 2013
    Posts
    18
    Location
    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.

    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

  3. #3
    VBAX Regular
    Joined
    Sep 2013
    Posts
    18
    Location
    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
            ' 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

    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

  4. #4
    VBAX Regular
    Joined
    Sep 2013
    Posts
    18
    Location
    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?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •