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:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Lookup Cell[/TD]
[TD]Result[/TD]
[/TR]
[TR]
[TD]1, 2, 4, 12, 14[/TD]
[TD]Relay burnt, Capacitor Burnt, Suction Joint Gas leak, Overload burnt, Thermostat dead[/TD]
[/TR]
</tbody>[/TABLE]


Helper Sheet

[TABLE="class: grid, width: 255, align: left"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]Sr No.[/TD]
[TD]Fault & Diagnosing[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Relay burnt[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Capacitor burnt[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Suction Joint Gas leak[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]1/3 Compressor low pressure[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]1/4 Compressor ceased[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]1/3 Condenser Leak[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]Capillary broken[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]Voltage problem[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]Suction Joint Gas leak[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Gas leak[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]Overload Burnt[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]Overlaod faulty[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]Thermostat dead
[/TD]
[/TR]
</tbody>[/TABLE]

 

[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:


[TABLE="class: grid, width: 704"]
<tbody>[TR]
[TD]Lookup Cell[/TD]
[TD]Result[/TD]
[/TR]
[TR]
[TD]1, 2, 4, 12, 14[/TD]
[TD]Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt, Thermostat dead[/TD]
[/TR]
[TR]
[TD]1,[/TD]
[TD]Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt, Thermostat dead, Relay burnt,[/TD]
[/TR]
[TR]
[TD]1, 2, 4, 12[/TD]
[TD]Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt, Thermostat dead, Relay burnt, , Relay burnt, Capacitor burnt, Suction Joint Gas leak, Overload Burnt[/TD]
[/TR]
[TR]
[TD]1, 2,[/TD]
[TD]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,[/TD]
[/TR]
[TR]
[TD]1, 2, 10,[/TD]
[TD]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,[/TD]
[/TR]
</tbody>[/TABLE]

 

[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.