Lookup Numbers & Result in Corresponding Text

[mohdamir1989]

Hi All,

Is it possible to lookup a string of numbers in any cell from other workbook and result in the corresponding text (Excel 2007)

Thank you in advance.


For example:

Lookup Cell	Result
1, 2, 4, 12, 14	Relay burnt, Capacitor Burnt, Suction Joint Gas leak, Overload burnt, Thermostat dead

<tbody>
</tbody>

Helper Sheet

Sr No.	Fault & Diagnosing
1	Relay burnt
2	Capacitor burnt
4	Suction Joint Gas leak
5	1/3 Compressor low pressure
6	1/4 Compressor ceased
7	1/3 Condenser Leak
8	Capillary broken
9	Voltage problem
10	Suction Joint Gas leak
11	Gas leak
12	Overload Burnt
13	Overlaod faulty
14	Thermostat dead

<colgroup><col><col></colgroup><tbody>
</tbody>

 

[mumps]

Assuming your results are in "Sheet1" and your Helper Sheet is "Sheet2", try:

Sub LookupNumbers()
    Application.ScreenUpdating = False
    Dim LastRow As Long, num As Range, foundNum As Range, vNum As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet, dic As Object
    Set dic = CreateObject("scripting.dictionary")
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With dic
        For Each num In desWS.Range("A2:A" & LastRow)
            vNum = Split(num, ",")
            For i = 0 To UBound(vNum)
                Set foundNum = srcWS.Range("A:A").Find(Trim(vNum(i)), LookIn:=xlValues, lookat:=xlWhole)
                If Not foundNum Is Nothing Then
                    If Not .Exists(foundNum.Offset(0, 1)) Then .Add foundNum.Offset(0, 1), foundNum.Offset(0, 1)
                End If
            Next i
            num.Offset(0, 1) = Join(.keys, ", ")
        Next num
    End With
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Another option

Sub MyConcat()
   Dim Cl As Range
   Dim Sws As Worksheet, Mws As Worksheet
   Dim Wrds As Variant, Tmp As Variant
   Dim i As Long
   
   Set Sws = Workbooks("[COLOR=#ff0000]book1.xlsm[/COLOR]").Sheets("[COLOR=#ff0000]List[/COLOR]")
   Set Mws = Sheets("[COLOR=#ff0000]Sheet3[/COLOR]")
   With CreateObject("scripting.dictionary")
      For Each Cl In Sws.Range("A2", Sws.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 1).Value
      Next Cl
      For Each Cl In Mws.Range("A2", Mws.Range("A" & Rows.Count).End(xlUp))
         Wrds = Split(Cl.Value, ", ")
         For i = 0 To UBound(Wrds)
            If Tmp = "" Then Tmp = .Item(CLng(Wrds(i))) Else Tmp = Tmp & ", " & .Item(CLng(Wrds(i)))
         Next i
         Cl.Offset(, 1).Value = Tmp
         Tmp = ""
      Next Cl
   End With
End Sub

Change workbook & sheet names in red to suit.

 

[mohdamir1989]

Assuming your results are in "Sheet1" and your Helper Sheet is "Sheet2", try:

Sub LookupNumbers()
    Application.ScreenUpdating = False
    Dim LastRow As Long, num As Range, foundNum As Range, vNum As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet, dic As Object
    Set dic = CreateObject("scripting.dictionary")
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With dic
        For Each num In desWS.Range("A2:A" & LastRow)
            vNum = Split(num, ",")
            For i = 0 To UBound(vNum)
                Set foundNum = srcWS.Range("A:A").Find(Trim(vNum(i)), LookIn:=xlValues, lookat:=xlWhole)
                If Not foundNum Is Nothing Then
                    If Not .Exists(foundNum.Offset(0, 1)) Then .Add foundNum.Offset(0, 1), foundNum.Offset(0, 1)
                End If
            Next i
            num.Offset(0, 1) = Join(.keys, ", ")
        Next num
    End With
    Application.ScreenUpdating = True
End Sub

Thank you @mumps for the effort. It is working perfectly for the example but when I change the numbers, the result is as below:

Lookup Cell	Result
1, 2, 4, 12, 14	Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt, Thermostat dead
1,	Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt, Thermostat dead, Relay burnt,
1, 2, 4, 12	Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt, Thermostat dead, Relay burnt, , Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt
1, 2,	Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt, Thermostat dead, Relay burnt, , Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt, Relay burnt, Capacitor burnt,
1, 2, 10,	Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt, Thermostat dead, Relay burnt, , Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt, Relay burnt, Capacitor burnt, , Relay burnt, Capacitor burnt, Suction Joint Gas leak,

<tbody>
</tbody>

 

[mohdamir1989]

Another option

Sub MyConcat()
   Dim Cl As Range
   Dim Sws As Worksheet, Mws As Worksheet
   Dim Wrds As Variant, Tmp As Variant
   Dim i As Long
   
   Set Sws = Workbooks("[COLOR=#ff0000]book1.xlsm[/COLOR]").Sheets("[COLOR=#ff0000]List[/COLOR]")
   Set Mws = Sheets("[COLOR=#ff0000]Sheet3[/COLOR]")
   With CreateObject("scripting.dictionary")
      For Each Cl In Sws.Range("A2", Sws.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 1).Value
      Next Cl
      For Each Cl In Mws.Range("A2", Mws.Range("A" & Rows.Count).End(xlUp))
         Wrds = Split(Cl.Value, ", ")
         For i = 0 To UBound(Wrds)
            If Tmp = "" Then Tmp = .Item(CLng(Wrds(i))) Else Tmp = Tmp & ", " & .Item(CLng(Wrds(i)))
         Next i
         Cl.Offset(, 1).Value = Tmp
         Tmp = ""
      Next Cl
   End With
End Sub

Change workbook & sheet names in red to suit.

Thank you @Fluff this is producing the desired results perfectly. Is there any formula solution available for the same?

Thank you once again for the efforts

 

[Fluff]

Glad we could help & thanks for the feedback.

If you have Office 365 then it might be possible with TextJoin, other than that, it might be possible with a shed load of helper columns.
Formulae aren't my strong suit so not sure.

 

[mumps]

My apologies. I forgot to clear the dictionary before going to the next value in the loop.

Sub LookupNumbers()
    Application.ScreenUpdating = False
    Dim LastRow As Long, num As Range, foundNum As Range, vNum As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet, dic As Object
    Set dic = CreateObject("scripting.dictionary")
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With dic
        For Each num In desWS.Range("A2:A" & LastRow)
            vNum = Split(num, ",")
            For i = 0 To UBound(vNum)
                Set foundNum = srcWS.Range("A:A").Find(Trim(vNum(i)), LookIn:=xlValues, lookat:=xlWhole)
                If Not foundNum Is Nothing Then
                    If Not .Exists(foundNum.Offset(0, 1)) Then .Add foundNum.Offset(0, 1), foundNum.Offset(0, 1)
                End If
            Next i
            num.Offset(0, 1) = Join(.keys, ", ")
            .RemoveAll
        Next num
    End With
    Application.ScreenUpdating = True
End Sub

 

[mohdamir1989]

Glad we could help & thanks for the feedback.

If you have Office 365 then it might be possible with TextJoin, other than that, it might be possible with a shed load of helper columns.
Formulae aren't my strong suit so not sure.

Thank you for the time and consideration. It helped a lot.

 

[mohdamir1989]

My apologies. I forgot to clear the dictionary before going to the next value in the loop.

Sub LookupNumbers()
    Application.ScreenUpdating = False
    Dim LastRow As Long, num As Range, foundNum As Range, vNum As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet, dic As Object
    Set dic = CreateObject("scripting.dictionary")
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With dic
        For Each num In desWS.Range("A2:A" & LastRow)
            vNum = Split(num, ",")
            For i = 0 To UBound(vNum)
                Set foundNum = srcWS.Range("A:A").Find(Trim(vNum(i)), LookIn:=xlValues, lookat:=xlWhole)
                If Not foundNum Is Nothing Then
                    If Not .Exists(foundNum.Offset(0, 1)) Then .Add foundNum.Offset(0, 1), foundNum.Offset(0, 1)
                End If
            Next i
            num.Offset(0, 1) = Join(.keys, ", ")
            .RemoveAll
        Next num
    End With
    Application.ScreenUpdating = True
End Sub

Thank you @mumps this working perfectly now.

 

[mumps]

My pleasure.