VBA Lookup from Table and Replace

[ryancgarrett]

I'm trying to create a function that will function similar to vlookup, but will replace the value instead of return it. The other caveat is there are multiple strings to be searched and replaced within a single cell:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD]Lookup Table[/TD]
[TD][/TD]
[TD][/TD]
[TD]String[/TD]
[TD][/TD]
[TD]Result[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD]Chevy[/TD]
[TD]A[/TD]
[TD][/TD]
[TD]Chevy,Dodge[/TD]
[TD][/TD]
[TD]A,B[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD]Dodge[/TD]
[TD]B[/TD]
[TD][/TD]
[TD]Chevy,Toyota,Dodge[/TD]
[TD][/TD]
[TD]A,R,B[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD]Toyota[/TD]
[TD]R[/TD]
[TD][/TD]
[TD]Toyota,Dodge[/TD]
[TD][/TD]
[TD]R,B[/TD]
[/TR]
</tbody>[/TABLE]

I'm thinking something along the lines of =LookReplace(StringCell,LookupTable,LookupResultColumn), i.e. in the table above Cell F2 would contain =LookupReplace(D2,A1:B4,2)

I know I need to use the split function to split the strings and work with the individual strings, but I'm lost as to the lookup portion.

 

[Yongle]

Is this what you want

Formula in F2 copied down

=LookUpReplace(D2,A:A)

Function LookUpReplace(aString As String, aList As Range)
    Dim arr, c As Long, aMatch As Variant, aStr As String, aVal As String
    arr = Split(aString, ",")

    For c = 0 To UBound(arr)
        aVal = Trim(arr(c))
        On Error Resume Next
            aMatch = aList.Find(aVal, lookat:=xlWhole).Offset(, 1).Value
            If Err.Number > 0 Then aMatch = aVal
            If aStr = vbNullString Then aStr = aMatch Else aStr = aStr & "," & aMatch
        On Error GoTo 0
    Next c
    LookUpReplace = aStr
End Function

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]

A​

[/th][th]

B​

[/th][th]

C​

[/th][th]

D​

[/th][th]

E​

[/th][th]

F​

[/th][th]

G​

[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

1​

[/td][td]Lookup Table [/td][td]

​

[/td][td][/td][td]String [/td][td][/td][td]Result[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

2​

[/td][td]chevy[/td][td]

A​

[/td][td][/td][td]Chevy,Dodge [/td][td][/td][td]A ,B [/td][td]

=LookUpReplace(D2,A:A)​

[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

3​

[/td][td]Dodge[/td][td]

B​

[/td][td][/td][td]Chevy,Toyota,Dodge [/td][td][/td][td]A ,R ,B [/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

4​

[/td][td]Toyota[/td][td]

R​

[/td][td][/td][td]Toyota,Dodge [/td][td][/td][td]R ,B [/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

5​

[/td][td][/td][td]

​

[/td][td][/td][td]Toyota, Dodge[/td][td][/td][td]R ,B [/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

6​

[/td][td][/td][td]

​

[/td][td][/td][td]Toyota, Ford[/td][td][/td][td]R ,Ford[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

7​

[/td][td][/td][td]

​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]

 

[pgc01]

Hi

Another option.

With Yongle's layout, in F2:

=LookUpReplace(D2,A:B)

Function LookUpReplace(s As String, rList As Range) As String
Dim v As Variant
With Application
    v = Split(.Trim(s), ",")
    LookUpReplace = Join(.IfError(.VLookup(v, rList, 2, 0), v), ",")
End With
End Function