lars_larsen
09-25-2013, 02:21 AM
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 me1061610616
sijpie
09-25-2013, 10:05 PM
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
sijpie
09-25-2013, 10:16 PM
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
sijpie
09-25-2013, 10:49 PM
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?
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.