Lookup and Join inquiry

[rn119]

I need to join a comma delimited list to a list that has the corresponding naming conventions. For example...

Table A - Starting from Cell A2

[TABLE="class: outer_border, width: 300"]
<tbody>[TR]
[TD]45,745[/TD]
[/TR]
[TR]
[TD]209,65,35[/TD]
[/TR]
[TR]
[TD]45,112,N60[/TD]
[/TR]
</tbody>[/TABLE]


Table B - Starting from Cell A2 (ID) & B2 (Name)

[TABLE="width: 166"]
<tbody>[TR]
[TD][TABLE="class: outer_border, width: 300"]
<tbody>[TR]
[TD]45[/TD]
[TD]Exam One[/TD]
[/TR]
[TR]
[TD]209[/TD]
[TD]Test Two[/TD]
[/TR]
[TR]
[TD]112[/TD]
[TD]Protocol[/TD]
[/TR]
[TR]
[TD]209[/TD]
[TD]Demo[/TD]
[/TR]
[TR]
[TD]35[/TD]
[TD]Prod[/TD]
[/TR]
[TR]
[TD]65[/TD]
[TD]Proof of Control[/TD]
[/TR]
[TR]
[TD]745[/TD]
[TD]Modality[/TD]
[/TR]
[TR]
[TD]N60[/TD]
[TD]Culture[/TD]
[/TR]
</tbody>[/TABLE]

My results in another column should be:

[TABLE="class: outer_border, width: 300"]
<tbody>[TR]
[TD]Exam One, Modality[/TD]
[/TR]
[TR]
[TD]Demo, Proof of Control, Prod[/TD]
[/TR]
[TR]
[TD]Exam One, Protocol, Culture[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Can this be done?

 

[mumps]

Start by formatting column A in Table A as 'Text'. The macro assumes that Table A is in Sheet1 and Table B is in Sheet2. Change the sheet names (in red) to suit your needs. The result will be place in column C of Sheet1.

Sub LookupAndJoin()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, rng As Range, i As Long, spl As Variant, fnd As Range, x As Long: x = 2
    Set desWS = Sheets("[COLOR="#FF0000"]Sheet1[/COLOR]")
    Set srcWS = Sheets("[COLOR="#FF0000"]Sheet2[/COLOR]")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In desWS.Range("A2:A" & LastRow)
        spl = Split(rng, ",")
        For i = LBound(spl) To UBound(spl)
            Set fnd = srcWS.Range("A:A").Find(spl(i), LookIn:=xlValues, lookat:=xlPart)
            If Not fnd Is Nothing Then
                If desWS.Cells(x, 3) = "" Then
                    desWS.Cells(x, 3) = fnd.Offset(, 1)
                Else
                    desWS.Cells(x, 3) = desWS.Cells(x, 3) & ", " & fnd.Offset(, 1)
                End If
            End If
        Next i
        x = x + 1
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

I show you another approach, maybe it can be faster.

Sub Join_Name()
  Dim a As Variant, b As Variant, c() As Variant, dict As Object, i As Long, s As Variant
  a = Sheets("[COLOR=#ff0000]Tab1[/COLOR]").Range("[COLOR=#0000ff]A2[/COLOR]", Sheets("[COLOR=#ff0000]Tab1[/COLOR]").Range("[COLOR=#0000ff]A[/COLOR]" & Rows.Count).End(xlUp))
  b = Sheets("[COLOR=#ff0000]Tab2[/COLOR]").Range("[COLOR=#0000ff]A2[/COLOR]", Sheets("[COLOR=#ff0000]Tab2[/COLOR]").Range("[COLOR=#0000ff]B[/COLOR]" & Rows.Count).End(xlUp))
  Set dict = CreateObject("scripting.dictionary")
  For i = 1 To UBound(b)
    dict.Add CStr(b(i, 1)), b(i, 2)
  Next
  ReDim c(UBound(a) - 1)
  For i = 1 To UBound(a)
    For Each s In Split(a(i, 1), ",")
      If dict.Exists(Trim(s)) Then
        c(i - 1) = c(i - 1) & ", " & dict(Trim(s))
      End If
    Next
    c(i - 1) = Mid(c(i - 1), 3)
  Next
  Sheets("[COLOR=#ff0000]Tab1[/COLOR]").Range("[COLOR=#0000ff]B2[/COLOR]").Resize(UBound(a)).Value = Application.Transpose(c)
End Sub

Note:
In your example you have twice the 209:
[TABLE="class: cms_table_outer_border, width: 300"]
<tbody>[TR]
[TD]209[/TD]
[TD]Test Two[/TD]
[/TR]
[TR]
[TD]112[/TD]
[TD]Protocol[/TD]
[/TR]
[TR]
[TD]209[/TD]
[TD]Demo[/TD]
[/TR]
</tbody>[/TABLE]