Fetch value for comma separated values from Single Cell.

[junior1505]

Dear Experts,
Greetings from India.
Is it possible that we can fetch values from comma separated values from a single cell to their corresponding values from a range?

Col A Col B Col C Col D
A AF A, B, D, E AF, AD, CMD, CW
B AD
C CA
D CMD
E CW

Col A and Col B are in master sheet, Col C is where we enter the values and Col D to fetch from the range of Col A & Col B.

Guide me is this is possible.

Regards.

 

[iggy_]

Can you just use text to column for this purpose?

https://support.office.com/en-us/ar...s-wizard-30b14928-5550-41f5-97ca-7a3e9c363ed7

 

[Fluff]

How about

Sub Junior()
   Dim Cl As Range
   Dim Ary As Variant
   Dim i As Long, s As String
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 1).Value
      Next Cl
      For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
         Ary = Split(Cl.Value, ",")
         For i = 0 To UBound(Ary)
            If .exists(Trim(Ary(i))) Then s = s & ", " & .Item(Trim(Ary(i)))
         Next i
         Cl.Offset(, 1).Value = Mid(s, 3)
         s = ""
      Next Cl
   End With
End Sub

 

[Rick Rothstein]

Here is another macro that you can consider...

[table="width: 500"]
[tr]
	[td]Sub FetchValues()
  Dim X As Long, Arr As Variant, Codes() As String
  Arr = Intersect(Range("A1").CurrentRegion, Columns("A:B"))
  Codes = Split([SUBSTITUTE(C1,", ",",")], ",")
  For X = 0 To UBound(Codes)
    Codes(X) = Application.VLookup(Codes(X), Arr, 2, False)
  Next
  [D1] = Join(Codes, ", ")
End Sub[/td]
[/tr]
[/table]

 

[Rick Rothstein]

Here is another macro that you can consider...

[table="width: 500"]
[tr]
	[td]Sub FetchValues()
  Dim X As Long, Arr As Variant, Codes() As String
  Arr = Intersect(Range("A1").CurrentRegion, Columns("A:B"))
  Codes = Split([SUBSTITUTE(C1,", ",",")], ",")
  For X = 0 To UBound(Codes)
    Codes(X) = Application.VLookup(Codes(X), Arr, 2, False)
  Next
  [D1] = Join(Codes, ", ")
End Sub[/td]
[/tr]
[/table]

For those who follow my postings, you know how much I like one-liners. On weekends, when things tend to be slow, I like to challenge myself to see if I can take a somewhat complex set of VB code lines and reduce them to a one-liner. Assuming the table in Column A and B remain fixed (seems like a reasonable assumption give the OP's setup in Message #1 ), the above code can be reduced to the following one-liner...

[table="width: 500"]
[tr]
	[td]Sub FetchValues()
  Range("D1") = Join(Application.Transpose(Application.Index([B1:B[B][COLOR="#FF0000"][SIZE=4]5[/SIZE][/COLOR][/B]], Evaluate("TRANSPOSE(MATCH({""" & Replace(Replace(Range("C1").Value, ", ", ","), ",", """,""") & """},A1:A[B][COLOR="#FF0000"][SIZE=4]5[/SIZE][/COLOR][/B],0))"))), ", ")
End Sub[/td]
[/tr]
[/table]

Note 1
--------------
I assumed the table in Columns A and B ended on Row 5 like Message #1 showed; however, I would expect the actual table is much longer, so the two red highlighted 5's above should be changed to the row number for the last entry in Column A.

Note 2
--------------
My recommendation is to not use this code, rather, use what I posted in Message #4 instead. As I said, this was a mental challenge for me which I thought others might find interesting but, while this code does in fact work, my other code would be much easier to follow and change if required in the future.