First time poster, long time lurker.
I am trying to create some VBA code for things Ive done using formulas up until now. Specifically I want to lookup the value from a SourceSheet based on two criteria, and return the value in column 7 to the TargetSheet. This is to pull in some financial data like the overall margin % for a jobs subtype.
The issue I am running into is not all the TargetSheets rows (Criteria1 & Criteria3) will be found in the SourceSheet, and some will be found but the value will be blank. This results in the code throwing me a type mismatch error during the below portion:
"If IsError(Application.Index(SourceRange, Application.Match(Criteria1 & Criteria2, SourceRange.Columns(4) & SourceRange.Columns(5), 0), 6)) Then"
Ive tried a lot of different ways to combat this, but all result in the type mismatch. Any help is appreciated!
Sub Margin_Trade_Update()
Dim SourceWB As Workbook, TargetWB As Workbook
Dim SourceSheet As Worksheet, TargetSheet As Worksheet
Dim Criteria1 As String, Criteria2 As String
Dim SourceRange As Range, TargetRange As Range
Dim MatchLC As Long, MatchTrade As Long
Dim LastRow As Long
Dim ResultCol As Long
'Set the source and target workbooks
Set SourceWB = Workbooks.Open("Path and Source workbook name")
Set TargetWB = ThisWorkbook
'Set the source and target worksheets
Set SourceSheet = SourceWB.Sheets("Margin - Trade")
Set TargetSheet = TargetWB.Sheets("01-25")
'Delete the first two rows of margin trade sheet
SourceSheet.Range("A1:A2").EntireRow.Delete
'Determine the last row in the target sheet
LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row
'Iterate through the rows in the target sheet for MTD Trade Margin
For i = 2 To LastRow
'Set the criteria and target range
Criteria1 = TargetSheet.Cells(i, "H").Value
Criteria2 = TargetSheet.Cells(i, "M").Value
Set TargetRange = TargetSheet.Cells(i, "AB")
'Find the match row and column in the source range
With SourceSheet
Set SourceRange = .Range(.Cells(1, 1), .Cells(.Rows.Count, .Columns.Count))
MatchLC = IIf(IsError(Application.Match(Criteria1, .Columns(4), 0)), 0, Application.Match(Criteria1, .Columns(4), 0))
MatchTrade = IIf(IsError(Application.Match(Criteria2, .Columns(5), 0)), 0, Application.Match(Criteria2, .Columns(5), 0))
End With
'Use INDEX and MATCH to retrieve the value from the source range
If IsError(Application.Index(SourceRange, Application.Match(Criteria1 & Criteria2, SourceRange.Columns(4) & SourceRange.Columns(5), 0), 6)) Then
TargetRange.Value = ""
Else
TargetRange.Value = Application.Index(SourceRange, Application.Match(Criteria1 & Criteria2, SourceRange.Columns(4) & SourceRange.Columns(5), 0), 6)
On Error GoTo 0
End If
Next i
'Close the source workbook
SourceWB.Close SaveChanges:=False
End Sub
Thank you @DecimalTurn !
Here is my code as of now after updating using your custom Function, but I tried letting it run for 20 minutes but just spins...
Function MatchWith2Criteria(LookUpRange1 As Range, Criteria1 As Variant, LookUpRange2 As Range, Criteria2 As Variant) As Variant
'N/A by default
MatchWith2Criteria = CVErr(xlErrNA)
'We need the two ranges to have the same height or we won't be able to align them
If (LookUpRange1.Rows.Count <> LookUpRange2.Rows.Count) Then
Exit Function
End If
'Here we are storing the values from the ranges inside arrays. This is mainly to improve performance as VBA doesn't have to access the worksheet data constantly.
Dim arr1() As Variant
arr1 = LookUpRange1.Columns(1).Value2
Dim arr2() As Variant
arr2 = LookUpRange2.Columns(1).Value2
Dim i As Long
For i = 1 To UBound(arr1)
If arr1(i, 1) = Criteria1 And arr2(i, 1) = Criteria2 Then
MatchWith2Criteria = i
Exit Function
End If
Next
End Function
Sub Margin_Trade_Update_V2()
' Update JCA tab with MTD Trade Margin
Dim SourceWB As Workbook, TargetWB As Workbook
Dim SourceSheet As Worksheet, TargetSheet As Worksheet
Dim Criteria1 As String, Criteria2 As String
Dim SourceRange As Range, TargetRange As Range
Dim MatchLC As Long, MatchTrade As Long
Dim LastRow As Long
Dim ResultCol As Long
'Set the source and target workbooks
Set SourceWB = Workbooks.Open("Path & File")
Set TargetWB = ThisWorkbook
'Set the source and target worksheets
Set SourceSheet = SourceWB.Sheets("Margin - Trade")
Set TargetSheet = TargetWB.Sheets("01-25")
'Delete the first two rows of margin trade sheet
SourceSheet.Range("A1:A2").EntireRow.Delete
'Determine the last row in the target sheet
LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row
'Iterate through the rows in the target sheet for MTD Trade Margin
For i = 2 To LastRow
'Set the criteria and target range
Criteria1 = TargetSheet.Cells(i, "H").Value
Criteria2 = TargetSheet.Cells(i, "M").Value
Set TargetRange = TargetSheet.Cells(i, "AB")
'Find the match row and column in the source range
With SourceSheet
Set SourceRange = .Range(.Cells(1, 1), .Cells(.Rows.Count, .Columns.Count))
'MatchLC = IIf(IsError(Application.Match(Criteria1, .Columns(4), 0)), 0, Application.Match(Criteria1, .Columns(4), 0))
'MatchTrade = IIf(IsError(Application.Match(Criteria2, .Columns(5), 0)), 0, Application.Match(Criteria2, .Columns(5), 0))
End With
'Use INDEX and MATCH to retrieve the value from the source range
Dim MyMatch As Variant
MyMatch = MatchWith2Criteria(SourceSheet.Columns(3), Criteria1, SourceSheet.Columns(4), Criteria2)
If IsError(MyMatch) Then
TargetRange.Value2 = ""
Else
TargetRange.Value2 = Application.Index(SourceRange, MyMatch, 6)
End If
Next i
End Sub
A final thank you to @DecimalTurn for helping me through this!
Here is the final code and some comments for changes I made:
'Needed to define the function so instead of figuring out how to nest it i just went the 'ol fashioned way
Function MatchOrZero(ByVal LookupVal As Variant, ByVal LookupRange As Range, Optional ByVal ReturnType As Long = 1) As Variant
On Error Resume Next
MatchOrZero = Application.Match(LookupVal, LookupRange, ReturnType)
If IsError(MatchOrZero) Then
MatchOrZero = 0
End If
On Error GoTo 0
End Function
Sub Margin_Trade_Update_V3()
' Update JCA tab with MTD Trade Margin
Dim SourceWB As Workbook, TargetWB As Workbook
Dim SourceSheet As Worksheet, TargetSheet As Worksheet
Dim SourceRange As Range, TargetRangeMTD As Range, TargetRangeLTD As Range
Dim LastRow As Long
Dim ResultCol As Long
'Set the source and target workbooks
Set SourceWB = Workbooks.Open("Path & File Here")
Set TargetWB = ThisWorkbook
'Set the source and target worksheets
Set SourceSheet = SourceWB.Sheets("Margin - Trade")
Set TargetSheet = TargetWB.Sheets("01-25")
'Delete the first two rows of margin trade sheet
SourceSheet.Range("A1:A2").EntireRow.Delete
'Determine the last row in the target sheet
LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row
'Iterate through the rows in the target sheet for MTD Trade Margin
Dim i As Long
For i = 2 To LastRow
'Set the criteria and target range
Dim Criteria1 As String, Criteria2 As String
Criteria1 = TargetSheet.Cells(i, "H").Value
Criteria2 = TargetSheet.Cells(i, "M").Value
Set TargetRangeMTD = TargetSheet.Cells(i, "AB")
Set TargetRangeLTD = TargetSheet.Cells(i, "AC")
'Find the match row and column in the source range
With SourceSheet
Set SourceRange = .Range(.Cells(1, 1), .Cells(.Rows.Count, .Columns.Count))
Dim MatchLC As Long
MatchLC = MatchOrZero(Criteria1, .Columns(4), 0)
Dim MatchTrade As Long
MatchTrade = MatchOrZero(Criteria2, .Columns(5), 0)
End With
'Use INDEX and MATCH to retrieve the value from the source range
Dim MyMatch As Variant
'N/A by default
MyMatch = CVErr(xlErrNA)
Dim LookUpRange1 As Range
Dim LookUpRange2 As Range
'needed to define SourceSheetLastRow
Dim SourceSheetLastRow As Long
SourceSheetLastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row
If LookUpRange1 Is Nothing Then
Set LookUpRange1 = SourceSheet.Range(SourceSheet.Cells(1, 4), SourceSheet.Cells(SourceSheetLastRow, 4))
Set LookUpRange2 = SourceSheet.Range(SourceSheet.Cells(1, 5), SourceSheet.Cells(SourceSheetLastRow, 5))
'Here we are storing the values from the ranges inside arrays. This is mainly to improve performance as VBA doesn't have to access the worksheet data constantly.
Dim arr1() As Variant
'Note here that you don't need to specify Columns(1) if LookUpRange is always a single-column range.
arr1 = LookUpRange1.Columns(1).Value2
Dim arr2() As Variant
arr2 = LookUpRange2.Columns(1).Value2
End If
Dim j As Long
For j = 1 To UBound(arr1)
If arr1(j, 1) = Criteria1 Then
If arr2(j, 1) = Criteria2 Then
'MyMatch = i - Needed to be j in this loop
MyMatch = j
Exit For
End If
End If
Next j
If IsError(MyMatch) Then
TargetRangeMTD.Value = ""
TargetRangeLTD.Value = ""
Else
TargetRangeMTD.Value2 = Application.Index(SourceRange, MyMatch, 6)
TargetRangeLTD.Value2 = Application.Index(SourceRange, MyMatch, 7)
End If
Next i
End Sub
CodePudding user response:
You problem comes from the fact that you are trying to combine two ranges with the "&" operator when you do SourceRange.Columns(4) & SourceRange.Columns(5)
. You are trying to concatenate two ranges, but VBA only knows how to concatenate strings or types that can be converted to string directly, so this explains the type error.
In this case, since you are trying to do a multi-criteria match in VBA, you can't exactly use the syntax that you would normally use in Excel when you use dynamic array formulas.
If you want to use that syntax you would have to create your own helper column with the data from column 3 and 4 concatenated.
Or you could also use a custom VBA function like this :
Function MatchWith2Criteria(LookUpRange1 As Range, Criteria1 As Variant, LookUpRange2 As Range, Criteria2 As Variant) As Variant
'N/A by default
MatchWith2Criteria = CVErr(xlErrNA)
'We need the two ranges to have the same height or we won't be able to align them
If (LookUpRange1.Rows.Count <> LookUpRange2.Rows.Count) Then
Exit Function
End If
'Here we are storing the values from the ranges inside arrays. This is mainly to improve performance as VBA doesn't have to access the worksheet data constantly.
Dim arr1() As Variant
arr1 = LookUpRange1.Columns(1).Value2
Dim arr2() As Variant
arr2 = LookUpRange2.Columns(1).Value2
Dim i As Long
For i = 1 To UBound(arr1)
If arr1(i, 1) = Criteria1 And arr2(i, 1) = Criteria2 Then
MatchWith2Criteria = i
Exit Function
End If
Next
End Function
Then, you could do something like this in your code:
Dim MyMatch As Variant
MyMatch = MatchWith2Criteria(SourceSheet.Columns(3), Criteria1, SourceSheet.Columns(4), Criteria2)
If IsError(MyMatch) Then
TargetRange.Value2 = ""
Else
TargetRange.Value2 = Application.Index(SourceRange,MyMatch,6)
End If
About performance (update)
As you mentioned in the comments, this approach can be slow when you have a lot of data, so one solution is to reduce the amount of data involved.
To reduce the amount of data involved, you could pass a range with limited size instead of passing the whole column. Then SourceSheet.Columns(3)
would then become something like this:
SourceSheet.Range(SourceSheet.Cells(1,3),SourceSheet.Cells(SourceSheetLastRow,3))
Where you can calculate SourceSheetLastRow
the same way you did for LastRow
, ie:
'Determine the last row in the source sheet (based on column A)
SourceSheetLastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row
This will likely help with the performance, but you could also go further to improve performance by reducing the number of access to the spreadsheet by incorporating the code of the function inside your procedure like this:
Dim i As Long
For i = 2 To LastRow
'Set the criteria and target range
Dim Criteria1 As String, Criteria2 As String
Criteria1 = TargetSheet.Cells(i, "C").Value
Criteria2 = TargetSheet.Cells(i, "D").Value
Set TargetRange = TargetSheet.Cells(i, "B")
'Find the match row and column in the source range
With SourceSheet
Set SourceRange = .Range(.Cells(1, 1), .Cells(.Rows.Count, .Columns.Count))
Dim MatchLC As Long
MatchLC = MatchOrZero(Criteria1, .Columns(3), 0)
Dim MatchTrade As Long
MatchTrade = MatchOrZero(Criteria2, .Columns(4), 0)
End With
'Use INDEX and MATCH to retrieve the value from the source range
Dim MyMatch As Variant
'N/A by default
MyMatch = CVErr(xlErrNA)
Dim LookUpRange1 As Range
Dim LookUpRange2 As Range
If LookUpRange1 Is Nothing Then
Set LookUpRange1 = SourceSheet.Range(SourceSheet.Cells(1, 3), SourceSheet.Cells(SourceSheetLastRow, 3))
Set LookUpRange2 = SourceSheet.Range(SourceSheet.Cells(1, 4), SourceSheet.Cells(SourceSheetLastRow, 4))
'Here we are storing the values from the ranges inside arrays. This is mainly to improve performance as VBA doesn't have to access the worksheet data constantly.
Dim arr1() As Variant
'Note here that you don't need to specify Columns(1) if LookUpRange is always a single-column range.
arr1 = LookUpRange1.Columns(1).Value2
Dim arr2() As Variant
arr2 = LookUpRange2.Columns(1).Value2
End If
Dim j As Long
For j = 1 To UBound(arr1)
If arr1(j, 1) = Criteria1 Then
If arr2(j, 1) = Criteria2 Then
MyMatch = i
Exit For
End If
End If
Next j
If IsError(MyMatch) Then
TargetRange.Value = ""
Else
TargetRange.Value2 = Application.Index(SourceRange, MyMatch, 6)
End If
Next i
The trick here is that LookUpRange1 Is Nothing
will be true only on the first iteration of the for-loop, so it allows us to read from the sheet data only once. Note that we're also using a nested if-statements (more on why here).
There's probably more tricks you could use such as the ones discussed in this article. The ones that would help the most here are probably the first two. Here's how I usually use them:
Dim InitialCalculationMode As Variant: InitialCalculationMode = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
On Error GoTo RestoreAppConfig
'Your code that takes a while to run
RestoreAppConfig:
With Application
.Calculation = InitialCalculationMode
.ScreenUpdating = True
End With
Alternatively, you could also pass an array to the Match function with the two columns already concatenated elementwise. You could perform the concatenation with a function like this :
Function ConcatenateElementWise(rng1 As Range, rng2 As Range) As Variant()
'Convert to array
Dim arr1() as Variant
arr1 = rng1.Value2
Dim arr2() as Variant
arr2 = rng2.Value2
Dim result() As Variant
ReDim result(LBound(arr1) To UBound(arr1))
Dim i As Long
For i = LBound(arr1) To UBound(arr1)
result(i) = arr1(i, 1) & arr2(i, 1)
Next i
ConcatenateElementWise = result
End Function
And then replace SourceRange.Columns(4) & SourceRange.Columns(5)
with ConcatenateElementWise(SourceRange.Columns(4), SourceRange.Columns(5))