Using VBA to vlookup each comma separated value in one cell and return emails

Question

I am hoping someone knows how to vlookup multiple comma separated values in one cell and provide semicolon separated output in the adjacent cell. I have noticed two other instances of this question on Stack Overflow but, unfortunately, both referred to using formulas (textjoin and vlookup) to solve this issue. Due to another VBA formula I am using, I need the final output to result solely in the text information, not in a formula. Is there any way to do this using VBA? Thanks in advance.

Answer 1

Figured out how to use the vlookup with the split using Ben's suggestion. Only issue is it puts a semicolon at the start of my email string, which is no issue for me but may be for another user.

Sub FINDEM()

    Dim ws As Worksheet
    Dim cel As Range
    Dim LastRow As Long, I As Long
    Dim WrdArray() As String

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row    'last row with data in Column A
        For Each cel In .Range("A2:A" & LastRow).Cells      'loop through each cell in Column A
            strg = ""
            Sal = ""
            WrdArray() = Split(cel, ", ")
            
            For I = LBound(WrdArray) To UBound(WrdArray)
                Sal = Sal & "; " & Application.WorksheetFunction.VLookup(WrdArray(I), Sheet1.Range("d2:e9"), 2, False)
            cel.Offset(0, 1) = Sal
            Next I
        Next
    End With
End Sub

Answer 2

You can do so without iteration, plus you might want to take into consideration removing duplicates. For example:

Sub Test()

Dim lr As Long
Dim arr As Variant, arrA As Variant, arrB As Variant

With ThisWorkbook.Sheets("Sheet1")

    'Get last used row and data into memory
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A2:B" & lr).Value

    'Join and transpose column A:A and B:B into their own array
    With Application
        arrA = Split(.Trim(Join(.Transpose(.Index(arr, 0, 1)), ",")), ",")
        arrB = Split(.Trim(Replace(Join(.Transpose(.Index(arr, 0, 2)), ";"), Chr(10), "")), ";")
    End With

    'Write array to sheet
    .Range("D2").Resize(UBound(arrA) + 1).Value = Application.Transpose(arrA)
    .Range("E2").Resize(UBound(arrB) + 1).Value = Application.Transpose(arrB)

    'Remove duplicates from column D:E
    .Range("D2:E" & UBound(arrA) + 1).RemoveDuplicates Array(1, 2), xlNo

End With

End Sub