Search code examples
excelvbaexcel-formulavlookuptextjoin

Vlookup return multiple values


I am trying to do Vlookup to return multiple values. However, the function takes really long to load. Is there any way to make it faster ? I got the function from online: https://www.extendoffice.com/documents/excel/2706-excel-vlookup-return-multiple-values-in-one-cell.html

  Function MYVLOOKUP(pValue As String, pWorkRng As Range, pIndex As Long)
  Dim rng As Range
  Dim xResult As String
  xResult = ""
  For Each rng In pWorkRng
   If rng = pValue Then
    xResult = xResult & " " & rng.Offset(0, pIndex - 1)
  End If
 Next
 MYVLOOKUP = xResult
 End Function

This is the code in the sub

 Sub sort()
Dim x As Integer
Dim result As Variant
Dim name As String
 Application.ScreenUpdating = False
  x = 10
 Do Until IsEmpty(Sheet9.Cells(x, 1).Value)
 name = Sheet9.Cells(x, 1).Value
 result = MYVLOOKUP(name, Sheet9.Range("K:M"), 3)
 Sheet9.Cells(x, 4).Value = result
 x = x + 1
 Loop
 End Sub

Solution

  • When you use Sheet9.Range("K:M") passed into the UDF as the pWorkRng parameter, it is used in the For Each rng In pWorkRng loop. This means that you are going to examine three entire columns or 3,145,728 cells; most of which are completely empty and two columns of which are not necessary for a VLOOKUP in any event. Small wonder why things are running slow.

    Either cut the range(s) down to the active area of data or use Intersect to trim full column references down to the .UsedRange.

    Option Explicit
    
    Function MYVLOOKUP(pValue As String, pWorkRng As Range, pIndex As Long)
        Dim rng As Range
        Dim xResult As String
    
        xResult = vbnullstring
        'the next line trims pWorkRng down to the .UsedRange
        Set pWorkRng = Intersect(pWorkRng, pWorkRng.Parent.UsedRange)
    
        'if you only want to examione the first column then use the following
        'For Each rng In pWorkRng.columns(1)
        'if you want to look through K, L and M for pValues then use this one,
        For Each rng In pWorkRng
            If rng = pValue Then
                xResult = xResult & " " & rng.Offset(0, pIndex - 1)
           End If
        Next
        MYVLOOKUP = trim(xResult)
     End Function
    

    I've added an option to only look in the first column. Your comparison is also case-sensitive; you might actually want that but VLOOKUP is typically not case-sensitive.