How to search for keywords in a column and return the values from the column next to the value found?

[Rodri]

Hello,


I have the following Excel data and I would like to return the repeated values found when the user searches for keywords.
It can be a formula and/or VBA code.



To be considered:

1. Column A and B have fixed values.

2. Column C and D are the keywords that the user will enter (not case sensitive).

3. Column E is what I would like to see. This cell will return the value from column A if matches were found anywhere on column B for values entered on columns C and D, considering:

• Separated by comma if more than one value is found;
• Return "not found" if no repeated results found.

	A	B	C	D	E
1	Ticket Number	Description	Search keyword 1 (user entry)	Search keyword 2 (user entry *can be empty)	Repeated Results
2	IN123456	Site has a network issue	network		IN777777
3	IN101010	Application issue and server error	application	server	IN222222,IN7777777
4	IN222222	Hardware issue found on the server	hardware	server	IN101010,IN7777777
5	IN777777	Internet unavailable due to network or server issue	internet	network	IN123456,IN333333
6	IN333333	VPN not working due to internet issue	VPN	internet	IN777777
7	IN444444	Mobile phone issue	mobile		not found

<tbody>
</tbody>

Thank you very much in advance for any help!

Rodri

 

[JLGWhiz]

This might work for you.

Sub doubleDip()
Dim sh As Worksheet, lr As Long, fn1 As Range, fn2 As Range, fAdr As String
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 3).End(xlUp).Row
With sh
    For i = 2 To lr
        Set fn1 = .Range("B:B").Find(.Cells(i, 3).Value, , xlValues, xlPart)
            If Not fn1 Is Nothing Then
                fAdr = fn1.Address
                Do
                    .Cells(i, 5) = .Cells(i, 5).Value & fn1.Offset(0, -1).Value & ", "
                    fn1 = .Cells(i, 3).Value
                    fn1 = .Range("B:B").FindNext(fn1)
                Loop While fn1.Address <> fAdr
            End If        
        If .Cells(i, 4) <> "" Then
            Set fn2 = .Range("B:B").Find(.Cells(i, 4).Value, , xlValues, xlPart)
                If Not fn2 Is Nothing Then
                    fAdr = fn2.Address
                    Do
                        Cells(i, 5) = .Cells(i, 5).Value & fn2.Offset(0, -1).Value & ", "
                        fn2 = .Cells(i, 4).Value
                        fn2 = .Range("B:B").FindNext(fn2)
                    Loop While fn2.Address <> fAdr                    
                End If
        End If
        If Application.CountIf(.Range("C2:D" & lr), .Cells(i, 3).Value) = 1 And .Cells(i, 4) = "" Then
            .Cells(i, 5) = "Not Found"
        End If
    Next
End With
End Sub

 

[Rodri]

Hi JLGWhiz,


Thank you for the quick reply.
I need further help, please.

Unfortunately, this code is changing column B (which can't be changed) and displaying the incorrect results on column E.


Thanks,
Rodri

 

[JLGWhiz]

Your example of expected results seems to indicate that you only want the second key word searched if the first one does not match. This code seaches both keywords, regardless, so where both keywords are in a single cell, you will get duplicate entries in column E. Maybe you can play with the code and get what you want.

Sub doubleDip()
Dim sh As Worksheet, lr As Long, c As Range, r As Range, rw As Range
Application.EnableCancelKey = xlDisabled
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 3).End(xlUp).Row
    With sh
    For Each c In .Range("C2:C" & lr)
        For Each r In .Range("B2:B" & lr)
            If InStr(r, c.Value) > 0 Then
                c.Offset(0, 2) = c.Offset(0, 2) & r.Offset(0, -1).Value & ", "
            End If
        Next
            If c.Offset(0, 1) <> "" Then
                For Each rw In .Range("B2:B" & lr)
                    If InStr(rw, c.Offset(0, 1).Value) > 0 Then
                        c.Offset(0, 2) = c.Offset(0, 2) & rw.Offset(0, -1).Value & ", "
                    End If
                Next
            End If
    Next
    End With
End Sub

I didn't think that the FindNext method was going to work too well, especially with the coding errors I had in it.

 

[JLGWhiz]

This one seems to produce the same results as your illustration in the OP. Give it a try.

Sub doubleDip()
Dim sh As Worksheet, lr As Long, c As Range, r As Range, rw As Range
Application.EnableCancelKey = xlDisabled
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 3).End(xlUp).Row
    With sh
    For Each c In .Range("C2:C" & lr)
        For Each r In .Range("B2:B" & lr)
            k1 = InStr(r, c.Value)
            If c.Offset(0, 1) <> "" Then
                k2 = InStr(r, c.Offset(0, 1).Value)
            End If
            If k1 > 0 Then
                c.Offset(0, 2) = c.Offset(0, 2) & r.Offset(0, -1).Value & ", "
            ElseIf k2 > 0 Then
                c.Offset(0, 2) = c.Offset(0, 2) & r.Offset(0, -1).Value & ", "
            End If
        Next
        If Application.CountIf(.Range("C2:D" & lr), c.Value) = 1 And c.Offset(0, 1) = "" Then
            c.Offset(0, 2) = "Not Found)"
        End If
    Next
    End With
End Sub

 

[Rodri]

Hi JLGWhiz,


Thank you.
That works perfectly with my example.

I'm just struggling a little to change it to my actual spreadsheet where the search fields are actually on columns Q and R (instead of C and D) and the result is on column S (instead of E).
Also they start from row 4.

I thought I was going to know how to modify it myself, but I can't get it to work

Please help

 

[JLGWhiz]

Hi JLGWhiz,


Thank you.
That works perfectly with my example.

I'm just struggling a little to change it to my actual spreadsheet where the search fields are actually on columns Q and R (instead of C and D) and the result is on column S (instead of E).
Also they start from row 4.

I thought I was going to know how to modify it myself, but I can't get it to work

Please help

try this

Sub doubleDip()
Dim sh As Worksheet, lr As Long, c As Range, r As Range
Application.EnableCancelKey = xlDisabled
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, "Q").End(xlUp).Row
    With sh
    For Each c In .Range("Q4:Q" & lr)
        For Each r In .Range("B4:B" & lr)
            k1 = InStr(LCase(r), LCase(c.Value))
            If c.Offset(0, 1) <> "" Then
                k2 = InStr(LCase(r), LCase(c.Offset(0, 1)))
            End If
            If c.Row <> r.Row And k1 > 0 Then
                c.Offset(0, 2) = c.Offset(0, 2) & r.Offset(0, -1).Value & ", "
            ElseIf c.Row <> r.Row And k2 > 0 Then
                c.Offset(0, 2) = c.Offset(0, 2) & r.Offset(0, -1).Value & ", "
            End If
        Next
        If Application.CountIf(.Range("Q4:R" & lr), c.Value) = 1 And c.Offset(0, 1) = "" Then
            c.Offset(0, 2) = "Not Found)"
        End If
    Next
    End With
End Sub

 

[JLGWhiz]

Also modify the declarations

Dim sh As Worksheet, lr As Long, c As Range, r As Range, [COLOR="#B22222"]k1 As Long, k2 As Long[/COLOR]