CODEWITHSUNDEEP
excelvbavlookup
Sean Mc
Sean Mc

Reputation: 468

Excel, VBA Vlookup, multiple returns into rows

Very new to VBA, so please excuse my ignorance.

How would you alter the code below to return the result into rows as opposed to a string?

Thanks in advance....

data

Acct No   CropType
-------   ---------
0001      Grain
0001      OilSeed
0001      Hay
0002      Grain

function

=vlookupall("0001", A:A, 1, " ")

Here is the code:

Function VLookupAll(ByVal lookup_value As String, _
                   ByVal lookup_column As range, _
                   ByVal return_value_column As Long, _
                   Optional seperator As String = ", ") As String

Application.ScreenUpdating = False
Dim i As Long
Dim result As String

For i = 1 To lookup_column.Rows.count
   If Len(lookup_column(i, 1).text) <> 0 Then
        If lookup_column(i, 1).text = lookup_value Then
            result = result & (lookup_column(i).offset(0, return_value_column).text &     seperator)
       End If
   End If
 Next

If Len(result) <> 0 Then
result = Left(result, Len(result) - Len(seperator))
End If

VLookupAll = result
Application.ScreenUpdating = True

 End FunctionNotes:

Upvotes: 0

Views: 7433

Answers (2)

Jsy
Jsy

Reputation: 9

How to use above code like an array?

=VLookupAll(Main!$B$1,'Tes'!$A1:$A$1500,{1,2})

Upvotes: 0

mkingston
mkingston

Reputation: 2718

Try this:

Option Explicit

Function VLookupAll(ByVal lookup_value As String, _
                    ByVal lookup_column As Range, _
                    ByVal return_value_column As Long) As Variant

    Application.ScreenUpdating = False
    Dim i As Long, _
        j As Long
    Dim result() As Variant

    ReDim result(1 To Application.Caller.Rows.Count, 1 To 1) As Variant
    j = LBound(result)

    For i = 1 To lookup_column.Rows.Count
        If Len(lookup_column(i, 1).Text) <> 0 Then
            If lookup_column(i, 1).Text = lookup_value Then
                If j > UBound(result, 1) Then
                    Debug.Print "More rows required for output!"
                    Exit For
                End If
                result(j, 1) = lookup_column(i).Offset(0, return_value_column).Text
                j = j + 1
            End If
         End If
    Next

    VLookupAll = result
    Application.ScreenUpdating = True

End Function

Now, when entering the formula on your sheet, select three cells, one above the other, then type the following:

=vlookupall("0001",$A:$A, 1, " ")

And press ctrl+shift+enter to enter the formula.

Note that if you have selected too few rows for output, your immediate window (press ctrl+g when in the vb editor) will display a message "More rows required for output!". I had this as a messagebox, but with automatic calculation on it gets a bit crazy..

Upvotes: 1

Related Questions