Contextual Guidance at the moment of need helps your employees adopt to new software or processes instantly. Boost knowledge retention and employee engagement step-by-step with one easy solution.
Become a Premium Member and unlock a new, free course in leading technologies each month.
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Public Function Match2(rgReturn As Range, rg1 As Range, Crit1 As Variant, rg2 As Range, Crit2 As Variant) As Variant
Dim v1 As Variant, v2 As Variant
Dim i As Long, n1 As Long
n1 = rg1.Worksheet.UsedRange.Rows.Count + rg1.Worksheet.UsedRange.Row - 1 'Last row with data in rg1.Worksheet
v1 = Range(rg1.Cells(1, 1), rg1.Worksheet.Cells(n1, rg1.Column)).Value
v2 = Range(rg2.Cells(1, 1), rg2.Worksheet.Cells(n1, rg2.Column)).Value
For i = 1 To n1
If IsError(v1(i, 1)) Or IsError(v2(i, 1)) Then
ElseIf v1(i, 1) = Crit1 And v2(i, 1) = Crit2 Then
Match2 = rgReturn.Cells(i, 1).Value
Exit Function
End If
Next
End Function
Public Function MatchMultiple(rgReturn As Range, ParamArray RangeAndCriteriaCombos() As Variant) As Variant
'Returns a value from rgReturn on first row that all satisfies all pairs of range and criteria. _
Function handles one or more pairs of range and criteria.
'RangeAndCriteriaCombos are alternating ranges and criteria, separated by commas in calling function. _
Each range is tested against its corresponding criteria.
Dim i As Long, j As Long, nCriteria As Long, n As Long
Dim bCriteria As Boolean
nCriteria = UBound(RangeAndCriteriaCombos)
If nCriteria Mod 2 <> 1 Then
MsgBox "RangeAndCriteriaCombos must be entered as pairs of ranges and criteria values, like SUMIFS function"
Exit Function
End If
n = rgReturn.Worksheet.UsedRange.Rows.Count + rgReturn.Worksheet.UsedRange.Row - 1 'Last row with data in rgreturn.Worksheet
For i = 1 To n
bCriteria = True
For j = 0 To nCriteria Step 2
If IsError(RangeAndCriteriaCombos(j)(i)) Then
bCriteria = False
Exit For
ElseIf RangeAndCriteriaCombos(j)(i) <> RangeAndCriteriaCombos(j + 1) Then
bCriteria = False
Exit For
End If
Next
If bCriteria = True Then
MatchMultiple = rgReturn.Cells(i).Value
Exit For
End If
Next
End Function
Match-Index-ExampleQ28364603.xlsm
=FindDate("Brett v Amanda","Meeting")
to save time in putting in complicated formula.Public Function FindDate(Crit1 As Variant, Crit2 As Variant) As Variant
Dim rgReturn As Range, rg1 As Range, rg2 As Range, LastRW As Long
Dim v1 As Variant, v2 As Variant
Dim i As Long, n1 As Long
LastRW = Cells(Rows.Count, 1).End(xlUp).Row
Set rgReturn = Range("$A1:$A$" & LastRW)
Set rg1 = Range("$B1:$B" & LastRW)
Set rg2 = Range("$C1:$C" & LastRW)
n1 = rg1.Worksheet.UsedRange.Rows.Count + rg1.Worksheet.UsedRange.Row - 1 'Last row with data in rg1.Worksheet
v1 = Range(rg1.Cells(1, 1), rg1.Worksheet.Cells(n1, rg1.Column)).Value
v2 = Range(rg2.Cells(1, 1), rg2.Worksheet.Cells(n1, rg2.Column)).Value
For i = 1 To n1
If IsError(v1(i, 1)) Or IsError(v2(i, 1)) Then
ElseIf v1(i, 1) = Crit1 And v2(i, 1) = Crit2 Then
FindDate = rgReturn.Cells(i, 1).Value
Exit Function
End If
Next
End Function
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
VBA how to use Like operator with phrasal verb? | 4 | 25 | |
Modify Text File with Excel Macro | 13 | 49 | |
VBA to trim leading and trailing spaces in all sheets of active workbook. | 2 | 19 | |
Need to count the pair | 33 | 16 |
Join the community of 500,000 technology professionals and ask your questions.