asked on

excel vba lookup function with multiple data elements in a single cell

looking for someone to help me write a quick and dirty function to look at ID numbers in a cell and to return a corresponding name (or names) associated with the ID number(s) via a lookup pointing to a separate array

IDs would be numeric in this format, seperated by "; " where there are multiples - eg
100 (for only one ID in a cell)
100; 101; 108 (for 3 IDs in a cell)
etc.
see attached file for more detail
thanks in advance

sample.xls

Jorge Paulino

Try something like this:

Public Function Owner(rg As Range) As String
Dim searchValues() As String
Dim rng As Range, searchID As Range
Dim x As Integer, columnIndex As Integer
Dim result As String

Set rng = [a22:b29]
columnIndex = 2

searchValues = Split(rg.Value, ";")

For x = 0 To UBound(searchValues)

    Set searchID = rng.Find(Trim(searchValues(x)))
    
    If Not searchID Is Nothing Then
        result = result & Cells(searchID.Row, columnIndex).Value & ";"
    Else
        result = result & "No Owner;"
    End If

Next

Owner = result

End Function

Open in new window

ASKER CERTIFIED SOLUTION

Jorge Paulino

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

patrickab

joetwa,

The code below is in the atached file. Press the button to get the results.

Patrick

Sub specialmacro()
Dim rng As Range
Dim celle As Range
Dim IDs() As String
Dim Owners() As String
Dim i As Long
Dim coll1 As New Collection
Dim coll2 As New Collection

With Sheets("Sheet1")
    If .Cells(2, "D") <> "" Then
        .Range(.Cells(2, "D"), .Cells(.Rows.Count, "D").End(xlUp).Offset(0, 1)).ClearContents
    End If
    Set rng = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
    For Each celle In rng
        IDs = Split(celle, ";")
        Owners = Split(celle.Offset(0, 1), ";")
        For i = 0 To UBound(IDs)
            On Error Resume Next
            coll1.Add CStr(IDs(i)), CStr(IDs(i))
            On Error Resume Next
            coll2.Add CStr(Owners(i)), CStr(Owners(i))
        Next i
        For i = 0 To UBound(IDs)
            IDs(i) = ""
            Owners(i) = ""
        Next i
    Next celle
    For i = 1 To coll1.Count
        .Cells(i + 1, "D") = coll1(i)
        .Cells(i + 1, "E") = Trim(coll2(i))
    Next i
End With
End Sub

Open in new window

splitter-01.xls

joetwa

ASKER

perfect - function works great - thanks for your help