Reputation: 1
I'm currently trying to figure out how to write a macro that will allow me to run a index/match with two criteria. I have a large database of information containing transaction information from multiple countries. I'd like to reference data in the "country" column and "date" column to match with a separate worksheet that contains foreign exchange rates. For countries and dates that match it would return the exchange rate for that date. I'd like the macro to run down to the last row of data in my sheet (it varies from time to time)
The formula syntax I originally created is:
=INDEX('FX_Index Lookup'!G:G,MATCH('Tool'!CJ2&'Tool'!DT2,'FX_Index Lookup'!C:C&'FX_Index Lookup'!H:H,0),FALSE)
When I drag this formula down, excel runs out of resources to continue running the calculation on the amount of data (rows) I need. I was hoping a Macro could solve this issue
Upvotes: 0
Views: 1160
Reputation: 398
The last function MatchQuery will return cells in column ReturnCol, where CriteriaColA = CriteriaA, CriteriaColB = CriteriaB... (similar syntax to SUMIFS)
Set rngRes = MatchQuery(ReturnCol, CriteriaColA, CriteriaA, CriteriaColB, CriteriaB ... etc)
Public Function IsRange(ByRef vnt As Variant) As Boolean
If IsObject(vnt) Then
If Not vnt Is Nothing Then
IsRange = TypeOf vnt Is Excel.Range
End If
End If
End Function
Public Function Union(ByRef rng1 As Range, _
ByRef rng2 As Range) As Range
If rng1 Is Nothing Then
Set Union = rng2
Exit Function
End If
If rng2 Is Nothing Then
Set Union = rng1
Exit Function
End If
If Not rng1.Worksheet Is rng2.Worksheet Then
Exit Function
End If
Set Union = Application.Union(rng1, rng2)
End Function
Public Function MatchAll(ByRef vntLookupValue As Variant, _
ByRef rngLookupArray As Range) As Range
Dim rngArea As Range
Dim rngTemp1 As Range
Dim rngTemp2 As Range
Dim vntMatch As Variant
Dim lngCount As Long
Dim lngLast As Long
If rngLookupArray Is Nothing Then
Exit Function
End If
For Each rngArea In rngLookupArray.Areas
If rngArea.Columns.Count > rngArea.Rows.Count Then
Set rngTemp1 = rngArea.Rows
Else
Set rngTemp1 = rngArea.Columns
End If
For Each rngTemp2 In rngTemp1
With rngTemp2
lngCount = .Cells.Count
lngLast = 0
Do
vntMatch = Application.Match(vntLookupValue, .Parent.Range(.Cells(lngLast + 1), .Cells(lngCount)), 0)
If IsError(vntMatch) Then
Exit Do
End If
lngLast = lngLast + vntMatch
Set MatchAll = Union(MatchAll, .Cells(lngLast))
Loop Until lngLast = lngCount
End With
Next rngTemp2
Next rngArea
End Function
Public Function MatchQuery(ByRef rngLookupArray As Range, _
ParamArray avntArgs() As Variant) As Range
Dim rngResult As Range
Dim i As Long
Dim rngTemp As Range
Dim rngMatches As Range
Set rngResult = rngLookupArray
For i = 0 To UBound(avntArgs) - 1 Step 2
If Not IsRange(avntArgs(i)) Then
Exit Function
End If
Set rngTemp = avntArgs(i)
Set rngMatches = MatchAll(avntArgs(i + 1), Intersect(rngResult.EntireRow, rngTemp))
If rngMatches Is Nothing Then
Exit Function
End If
Set rngResult = Application.Intersect(rngResult, rngMatches.EntireRow)
Next i
Set MatchQuery = rngResult
End Function
Upvotes: 0