Searching for keywords in ranges and show result (1 Viewer)

rehanemis

Registered User.
Local time
Today, 20:52
Joined
Apr 7, 2014
Messages
195
Hi,
I have a spreadsheet and I would like to show result based on keyword matched. So I have list of all keywords in columns (column Heading will be the result if keyword matched with string). So I have about 10 keywords columns and String in a range upto 50. I would like to see the result in E if keyword matched with any mentioned columns. In current case 1122 is matched in P heading and NDO2 is matched in S heading so result is accordingly. How to do it with vba?
keyword.JPG
 

June7

AWF VIP
Local time
Today, 08:52
Joined
Mar 9, 2014
Messages
5,470
That first space in "NDO 2 Department" will be an annoying complication.

I thought simplest approach would utilize recordset. I have tried ADO recordset Find method. It errors when the field is not on left side of LIKE expression. DAO FindFirst doesn't error but also doesn't work. So I resorted to looping recordset.
Code:
    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1
    Dim cn As Object, rs As Object, x As Integer, s As String
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    cn.Open "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName & ";HDR=Yes';"
    
    s = "SELECT 'P' AS C, P AS Data FROM [Sheet3$]" & _
        "UNION SELECT 'S', S FROM [Sheet3$]"
    rs.Open s, cn, adOpenStatic, adLockOptimistic, adCmdText
    For x = 2 To 3
        rs.MoveFirst
        Do While Not rs.EOF
            If InStr(Replace(Range("D" & x), " ", ""), rs!Data) > 0 Then
                Range("E" & x).Value = rs!C
                Exit Do
            End If
            rs.MoveNext
        Loop
    Next

I am sure there are several ways to go about this but will require much different and more complicated code.
 

Users who are viewing this thread

Top Bottom