PDA

View Full Version : mvlookup unique values



jdelaney123
11-14-2012, 11:02 AM
I'm using a vba script to receive multiple results from a vlookup

Option Explicit
Function MVLookup(lookupValue, tableArray As Range, colIndexNum As Long, _
Optional NotUsed As Variant) As Variant

Dim initTable As Range
Dim myRowMatch As Variant
Dim myRes() As Variant
Dim myStr As String
Dim initTableCols As Long
Dim i As Long
Dim ubound_myRes As Long

Set initTable = Nothing
On Error Resume Next
Set initTable = Intersect(tableArray, _
tableArray.Parent.UsedRange.EntireRow)
On Error GoTo 0

If initTable Is Nothing Then
MVLookup = CVErr(xlErrRef)
Exit Function
End If

initTableCols = initTable.Columns.Count

i = 0
Do
myRowMatch = Application.Match(lookupValue, initTable.Columns(1), 0)

If IsError(myRowMatch) Then
Exit Do
Else
i = i + 1
ReDim Preserve myRes(1 To i)
myRes(i) _
= initTable(1).Offset(myRowMatch - 1, colIndexNum - 1).Text
If initTable.Rows.Count <= myRowMatch Then
Exit Do
End If
On Error Resume Next
Set initTable = initTable.Offset(myRowMatch, 0) _
.Resize(initTable.Rows.Count - myRowMatch, _
initTableCols)
On Error GoTo 0
If initTable Is Nothing Then
Exit Do
End If
End If
Loop

If i = 0 Then
MVLookup = CVErr(xlErrNA)
Exit Function
End If

myStr = ""
For i = LBound(myRes) To UBound(myRes)
myStr = myStr & ", " & myRes(i)
Next i

MVLookup = Mid(myStr, 3)

End Function

But I end up with the same value populating as many times as it's displayed in my lookup table and I would like the results to display each unique value once.

Bob Phillips
11-14-2012, 04:48 PM
Function MVLookup(lookupValue, tableArray As Range, colIndexNum As Long, _
Optional NotUsed As Variant) As Variant

Dim initTable As Range
Dim myRowMatch As Variant
Dim myRes() As Variant
Dim initTableCols As Long
Dim i As Long
Dim ubound_myRes As Long
Dim tmp As Variant

Set initTable = Nothing
On Error Resume Next
Set initTable = Intersect(tableArray, _
tableArray.Parent.UsedRange.EntireRow)
On Error GoTo 0

If initTable Is Nothing Then
MVLookup = CVErr(xlErrRef)
Exit Function
End If

initTableCols = initTable.Columns.Count

i = 0
ReDim myRes(1 To 1)
Do
myRowMatch = Application.Match(lookupValue, initTable.Columns(1), 0)

If IsError(myRowMatch) Then
Exit Do
Else
tmp = initTable(1).Offset(myRowMatch - 1, colIndexNum - 1).Text
If IsError(Application.Match(tmp, myRes, 0)) Then
i = i + 1
ReDim Preserve myRes(1 To i)
myRes(i) = tmp
End If
If initTable.Rows.Count <= myRowMatch Then
Exit Do
End If
On Error Resume Next
Set initTable = initTable.Offset(myRowMatch, 0) _
.Resize(initTable.Rows.Count - myRowMatch, _
initTableCols)
On Error GoTo 0
If initTable Is Nothing Then
Exit Do
End If
End If
Loop

If i = 0 Then
MVLookup = CVErr(xlErrNA)
Else
MVLookup = Join(myRes, ",")
End If
End Function