I want to create an Excel function in vba that works identically to VLOOKUP, but has an extra argument to let you pick the nth unique result.

Here's non working code that I've come up with so far. It does not work and a bit incomplete, but I think you can see where I'm going. I'm pretty bad at VBA, so if there's anything I could/should do better or faster, please let me know, no matter how rude or dumb it sounds. Or if there's already a set of functions that can do this.

Function MVLOOKUP(lookup_value, table_array As Range, col_index_num As Long, entry_num As Long, Optional range_lookup As Boolean) As Variant
    'Purpose: VLOOKUP but it finds ALL the matching entries, not just the first one.
    'returns the entry you want by its number, starting at one
    'entry_num is the entry to return
    'most of this copied from top answer on this stackoverflow entry
        Dim FoundCell As Range
        Dim LastCell As Range
        Dim FirstAddr, find_value As String
        Dim rFound As Variant
        Dim strFound() As String
        Dim my_range As Range
        Dim row_count, col_count As Long
        Dim vLookAt As Integer
        col_count = table_array.Columns.Count
        find_value = lookup_value

        If col_index_num >= 0 Then      'sets range to do only be 1 column wide???
            Set my_range = table_array.Resize(, 1)
            Set my_range = table_array.Resize(, 1).Offset(0, col_count - 1)
        End If
        With my_range 'no idea why this is here
            row_count = .Cells.Count
            If row_count = 1048576 Then row_count = .Cells(.Cells.Count).End(xlUp).Row
        End With
        Set my_range = my_range.Resize(row_count)
        Set LastCell = my_range.Cells(my_range.Cells.Count)
        If IsMissing(range_lookup) Or range_lookup Then
            vLookAt = 2 'xlPart
            vLookAt = 1 'xlWhole
        End If
'        If IsMissing(range_lookup) Or range_lookup Then
'            Set FoundCell = my_range.Find(what:=find_value, after:=LastCell, LookIn:=xlFormulas, _
'                                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
'                                MatchCase:=False, SearchFormat:=False)
'        Else
'            Set FoundCell = my_range.Find(what:=find_value, after:=LastCell, LookIn:=xlFormulas, _
'                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
'                                MatchCase:=False, SearchFormat:=False)
'        End If
        Set FoundCell = my_range.Find(what:=find_value, after:=LastCell, LookIn:=xlValues, _
                                LookAt:=vLookAt, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                MatchCase:=False, SearchFormat:=False)
        If Not FoundCell Is Nothing Then 'We found something!
            i = 0
            rFound(i) = FoundCell.Address
            strFound(i) = rFound(i).Offset(0, col_index_num - 1)
            If IsNumeric(col_index_num) And Abs(col_index_num) <= col_count Then
               'search, if found, search (for each) current array,
                        'probably should just set last cell at the end of every loop? or use MSDN example for findnext??????
                        Set FoundCell = my_range.FindNext(after:=rFound(i))

                        rFound(i) = FoundCell.Address
                        If rFound(i) = rFound(0) Then
                            MVLOOKUP = CVErr(xlErrNA)
                            Exit Function
                        End If
                        If NewElem(rFound(i).Value, strFound()) Then      'only iterate i if there was a new element
                            strFound(i) = rFound(i).Offset(0, col_index_num - 1)
                            i = i + 1
                        End If
                    Loop While i < entry_num        'entry_num starts at 1, but array starts at 0
                    MVLOOKUP = strFound(entry_num - 1)
                    Exit Function
            Else            'Returns #REF excel error if there's an error in the column reference
                MVLOOKUP = CVErr(xlErrRef)
                Exit Function
            End If
        Else        'Returns #N/A if notthing found
            MVLOOKUP = CVErr(xlErrNA)
            Exit Function
        End If

End Function

Function NewElem(strCheck As String, myArray() As String) As Boolean
'    For i = LBound(myArray) To UBound(myArray) - 1
'        If strCheck = myArray(i) Then
'            IsInArray = True
'            Exit Function
'        End If
'    Next i
    For Each i In strCheck()
        myArray() = Filter(myArray, strCheck, compare:=vbTextCompare)
        If (UBound(myArray) - LBound(myArray) + 1) > 0 Then
            NewElem = True
            Exit Function
        End If
    NewElem = False
End Function


For recent versions of Excel, you can use INDEX/FILTER to achieve this:

enter image description here

Formula in cell F15:


Where the lookup value is in E15 and the n for the nth item is in E16.

  • wow thats super easy
    – inund8
    Jan 14 at 19:13

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.