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

Posted on 2009-12-23
Last Modified: 2013-11-25
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)
see attached file for more detail
thanks in advance

Question by:joetwa
    LVL 48

    Expert Comment

    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 & ";"
            result = result & "No Owner;"
        End If
    Owner = result
    End Function

    Open in new window

    LVL 48

    Accepted Solution

    Here's the sample file ...
    LVL 45

    Expert Comment


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

    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


    Author Closing Comment

    perfect - function works great - thanks for your help

    Featured Post

    Looking for New Ways to Advertise?

    Engage with tech pros in our community with native advertising, as a Vendor Expert, and more.

    Join & Write a Comment

    When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
    This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
    The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
    This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

    729 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    19 Experts available now in Live!

    Get 1:1 Help Now