Convert Comma Separated Values to matching Comma Separated Strings

The VBA looks like this.

Sorry, correction below.

'# Arguments:
'# vs = value sought, a delimited list of codes
'# ra = lookup table, matching codes in vs against 1st column of ra, categories in 2nd column, values in last column
'# id = 'input' delimiter for codes in vs
'# od = 'output' delimited for values in last column of ra
'#
'# Propagates error values in any of the arguments. Returns Empty if no items in vs match 1st column of ra.
Function multilookup( _
 vs As Variant, _
 ra As Variant, _
 Optional id As String = ", ", _
 Optional od As String = ", " _
) As Variant
'-------------------------------
  Const DD As String = " ; "
  Dim i As Long, j As Long, k As Long
  Dim rc As Variant, rv As Variant

  '# propagate errors
  If IsError(id) Then
    multilookup = id
    Exit Function
  End If

  If IsError(od) Then
    multilookup = od
    Exit Function
  End If

  If IsError(vs) Then
    multilookup = vs
    Exit Function
  Else
    '# use only 1st item if vs is range or array
    If IsArray(vs) Then
      For Each rv In vs
        vs = rv
        Exit For
      Next rv
    End If

    vs = Split(vs, id)
  End If

  '# propagate errors
  If IsError(ra) Then
    multilookup = ra
    Exit Function
  Else
    '# note: assumed to be n-row by 2- or 3-column
    If TypeOf ra Is Range Then ra = ra.Areas(1).Value
  End If

  ReDim rc(1 To 2, 1 To 4)  '# initial guess
  k = 0  '# for 2nd dim of rc

  For i = LBound(vs) To UBound(vs)
    With Application
      rv = Empty

      '# match items in vs against 1st column of ra
      '--------------------------------------------
      '# Split() above only produces arrays of strings.
      '# If the fields are numeric, try numeric matching first.
      If IsNumeric(vs(i)) Then
        rv = .Match(CDbl(vs(i)), .WorksheetFunction.Index(ra, 0, 1), 0)
      End If

      '# If no match yet, try text matching.
      If IsError(rv) Or IsEmpty(rv) Then
        rv = .Match(vs(i), .WorksheetFunction.Index(ra, 0, 1), 0)
      End If

      '# If still no match, skip.
      If IsError(rv) Then GoTo Continue

      j = CLng(rv)

      '# match 2nd column item in ra against 1st row of rc
      '---------------------------------------------------
      rv = .Match(ra(j, 2), .WorksheetFunction.Index(rc, 1, 0), 0)

      '# If no match, then new category to enter into rc.
      If IsError(rv) Then
        k = k + 1
        If k > UBound(rc, 2) Then
          ReDim Preserve rc(1 To 2, 1 To 2 * UBound(rc, 2))
        End If
        rc(1, k) = ra(j, 2)
        rc(2, k) = ra(j, UBound(ra, 2))

      '# Otherwise, existing category, supplement 2nd row of rc.
      Else
        rc(2, rv) = rc(2, rv) & od & ra(j, UBound(ra, 2))

      End If
    End With

Continue:
  Next i

  Erase vs

  '# If no matches at all, return Empty.
  If k = 0 Then Exit Function

  rv = ""
  For i = 1 To k
    rv = rv & DD & RTrim$(rc(1, i)) & " " & rc(2, i)
  Next i

  multilookup = Mid$(rv, Len(DD) + 1)

  Erase rc

End Function

I'm also attaching a workbook to show how it works.