Vlookup substrings of a text,concatenate results into another string

[Jubinell]

Hi,

I have a text in a cell which is a series of company codes. Like this: "C1 C2 C3 C4". Each of these codes correspond to a real company name in a table. I'd like to extract the individual codes from the string, use them to look up company names in the table, and concatenate the results into a string and storing that in another cell.

I plan to do this in 3 UDFs:

1) Extract substrings from original text.
I make use of the Split() function in VBA.

Public Function mySplit(inSplit As Range, Sep As String) As Variant
mySplit = Split(inSplit.Value, Sep)
End Function

2) Vlookup the substrings then store the results in an array
Not sure how to do this yet. Any ideas?

Public Function myVLookup(inV() As Variant) As Variant
...
End Function

3) Concatenate the array members back into one string

Public Function MyConc(InConc() As Variant, Optional Sep As String) As String
On Error Resume Next
Dim OutStr As String
Dim i As Integer
For i = LBound(InConc, 1) To UBound(InConc, 1)
     If InConc(i) <> "" Then OutStr = OutStr & InConc(i) & Sep
Next i
MyConc = Left(OutStr, Len(OutStr) - Len(Sep))
End Function

After that, I'll just nest the 3 UDFs together, something like this:
=MyConc(myVLookup(mySplit(C2, "")), " ")

Is there anything wrong in what I'm doing?
And can you fill in the gap for step 2?

Thank you for your help

 

[parry]

Hi, may not be what your after but perhaps?...

Function MultiVLookup(rngLookupValues As Range, strValueDelimiter As String, rngLookupRange As Range, TargetColumn As Integer) As String
Dim varSplitValues As Variant, varItem As Variant, strResult As String, i As Integer, varLookupResult As Variant

varSplitValues = Split(rngLookupValues, strValueDelimiter, -1, vbTextCompare)

For Each varItem In varSplitValues
    
    On Error Resume Next
    varLookupResult = Application.WorksheetFunction.VLookup(varItem, rngLookupRange, TargetColumn, False)

    If Err.Number <> 0 Then
        strResult = strResult & "#CompanyNameNotFound#"
        Err.Clear
    Else
        strResult = strResult & varLookupResult
    End If
    On Error GoTo 0
    
    If UBound(varSplitValues) <> i Then
        strResult = strResult & ", "
    End If
    i = i + 1
Next varItem

MultiVLookup = strResult

End Function

 

[Jubinell]

Wow that works flawlessly! I would have preferred to have the vlookup results returned as an array first before being converted to text (I'll need them some other place) but this is fine for now.

Thank you!

 

[Jubinell]

Hi Parry,

I tried to modify what you gave me so that I can create an array of lookup results before turning them into one single string. Here is what I've got:

Function MultiVLookup(rngLookupValues As Range, strValueDelimiter As String, rngLookupRange As Range, TargetColumn As Integer, Sep As String) As String
Dim varSplitValues As Variant, varItem As Variant, strResult() As Variant, i As Integer, varLookupResult As Variant

varSplitValues = Split(rngLookupValues, strValueDelimiter, -1, vbTextCompare)

ReDim strResult(UBound(varSplitValues)) As Variant

For Each varItem In varSplitValues
    On Error Resume Next
    varLookupResult = Application.WorksheetFunction.VLookup(varItem, rngLookupRange, TargetColumn, False)

    If Err.Number <> 0 Then
        strResult(i) = "#CompanyNameNotFound#"
        Err.Clear
    Else
        strResult(i) = varLookupResult
    End If
    On Error GoTo 0
    i = i + 1
Next varItem

MultiVLookup = ConcSep_Array(strResult, Sep)

End Function

Public Function ConcSep_Array(InArray() As Variant, Optional Sep As String) As String
'this is one-dimensional only
On Error Resume Next
Dim OutStr As String
Dim i, j As Integer
For i = LBound(InArray, 1) To UBound(InArray, 1)
    If InArray(i) <> "" Then OutStr = OutStr & InArray(i) & Sep
Next i
ConcSep_Array = Left(OutStr, Len(OutStr) - Len(Sep))
End Function

The ConcSep_Array() function is my solution to merge array members into a single text string.

It seems to work OK so far.
Thank you.