How to Select a value separated by ; in a cell to lookup

[Jainanki]

Hi,

this has been driving me crazy and i am unable to find a formula to drive me the result. Please refer to the below case.

[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]e[/TD]
[/TR]
[TR]
[TD]234563; 234575; 564543[/TD]
[TD]Apple[/TD]
[TD]Yes[/TD]
[TD]234575[/TD]
[TD](Apple)[/TD]
[/TR]
[TR]
[TD]223344; 278923; 232324[/TD]
[TD]mango[/TD]
[TD]No[/TD]
[TD]232324[/TD]
[TD](Mango)[/TD]
[/TR]
[TR]
[TD]123456; 567890[/TD]
[TD]banana[/TD]
[TD]Yes[/TD]
[TD]123456[/TD]
[TD](Banana)[/TD]
[/TR]
</tbody>[/TABLE]

How can get the values in column E i.e. apple, mango and banana using D1 as the lookup array. First challenge is to derive the value in D from cell A and then lookup.

Please note that split cells wont work as there can be instances where i could have more than 200 numbers in a cell.

Appreciate your swift response on this.

Regards,
Ankit Jain

 

[Jainanki]

Apologies Eric. This is actually giving me the desired output. I really appreciate the effort and Hard work you have put in. It might be easy for you but i am a beginner in VB but i highly appreciate your help....

Let me actually work on the final worksheet. I will get back to you again with more compliments.

Appreciate,
Jainanki

 

[Jainanki]

Hi Eric,

thank you for the code. However this formula is being used for a huge database and application calculation is creating is problem. I am not able to operate the workbook at all.

Could you please assist on this as well. Thank you in advance.

 

[Eric W]

If you have a huge spreadsheet with a lot of calculations, and this UDF slows it down so that it's unusable, I see 2 options. First, you can go to the Formulas tab and change the Calculation option to Manual. Then the sheet will only calculate when you ask it to (F9). If that's not workable, then the other option is to change the UDF from a function to an on-demand macro.

Sub GetResults()
Dim SrcRange As Range, ResRange As Range
Dim Src As Variant, Res As Variant
Dim MyDictA As Object, MyDictB As Object
Dim i As Long, j As Long
Dim wk As Variant, wk1 As String

    Set SrcRange = Sheets("Sheet1").Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row)
    Set ResRange = Sheets("Sheet1").Range("F2:H" & Cells(Rows.Count, "F").End(xlUp).Row)
    
    Src = SrcRange.Value
    Res = ResRange.Value
    
    Set MyDictA = CreateObject("Scripting.Dictionary")
    Set MyDictB = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(Src)
        wk = Split(Src(i, 1), ";")
        For j = 0 To UBound(wk)
            wk1 = Trim(wk(j))
            MyDictA.Item(wk1) = MyDictA.Item(wk1) & Src(i, 2) & "; "
            MyDictB.Item(wk1) = MyDictB.Item(wk1) & Src(i, 3) & "; "
        Next j
    Next i
    
    For i = 1 To UBound(Res)
        wk1 = Trim(Res(i, 1))
        If MyDictA.exists(wk1) Then
            Res(i, 2) = Left(MyDictA.Item(wk1), Len(MyDictA.Item(wk1)) - 2)
            Res(i, 3) = Left(MyDictB.Item(wk1), Len(MyDictB.Item(wk1)) - 2)
        End If
    Next i
    
    ResRange.Value = Res
    
End Sub

Place this on the same VBA sheet as the UDF. Make sure the source and result ranges (in red) are pointing to the right place. You can run this in a variety of ways. Press Alt-F8 to bring up the macros selection box, select it and click Run. Or we can set up a CommandButton or hot key.

Let me know if this helps.

 

[Jainanki]

Hi Eric,

Thank you for the codes your provided previously and indeed it has helped in various ways. However i would place another request.

As your have provided the above code which would help in making the macro faster, is there a way we can make it work without changing the formulas i.e. keeping the formula intact and not pasting every cells as values.

regards,