• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 241
  • Last Modified:

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)
see attached file for more detail
thanks in advance

  • 2
1 Solution
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

Here's the sample file ...

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

joetwaAuthor Commented:
perfect - function works great - thanks for your help

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now