How to search a column with keywords and write decimal value in to a row

Hi ,

I have a excel work sheet. It has 5856 file names in the B column.
I want to search particular file name by keyword search.
If the keyword match with a file name or part of the file name then I want to write a new decimal value in the same row but in the C column.


For example I want to search Project management keyword in the B column (B1:B5856). If I found three results such as in B5, B10, B5050 then I want to write 1.01 values in to C5, C10 and C5050.


Could you please help me?

Here is a way using A filter Macro

Sub Button1_Click()
    Dim r As Range, s As String

    Set r = Range("B2", Range("B65536").End(xlUp))

    r.Offset(0, 1).ClearContents

    s = InputBox("What to find?")

    With Range("B1")
        .AutoFilter Field:=1, Criteria1:="*" & s & "*"
        
        On Error Resume Next
        
        Set Rng = r.Cells.SpecialCells(xlCellTypeVisible) 'if no items found
        
        If Rng Is Nothing Then
            MsgBox "No records found"
            .AutoFilter
            Exit Sub
        End If
        
        r.Offset(0, 1) = 1.01
        .AutoFilter
    End With


End Sub

Check out the Example

Thanks for your msg,

I'd like to scan B(B1:B5056) column for a certain word (e.g. "Project Management") and put a code (e.g. "PM") on the cell next to it each time it finds it. In this case, "Project Management" might be by itself or in the middle of a sentence.Also "Project Management" keyword can exist more than one place in the B column.

Can you help me pls?

My code works just fine.
You will have to attach a sample of your workbook, to see what the problem is.
Keep it to 50 rows or so

According to your advise the code would be

Sub Button_click()
Dim r As Range, s As String

    Set r = Range("B2", Range("B5856").End(xlUp))

    r.Offset(0, 2).ClearContents

    s = InputBox("What to find?")

    With Range("B1")
        .AutoFilter Field:=1, Criteria1:=s
        
        On Error Resume Next
        
        Set Rng = r.Cells.SpecialCells(xlCellTypeVisible) 'if no items found
        
        If Rng Is Nothing Then
            MsgBox "No records found"
            .AutoFilter
            Exit Sub
        End If
        
        r.Offset(0, 2) = 1.01
        .AutoFilter
    End With


End Sub

If I type Project Management Plan its displays 1.01 in the D1 cell. It is wrong. 1.01 should be in 58 cells( D4,D14,D58.... etc.)

Check out the amended code

Stop changing the code! I have it at B65536 for a reason, so the code will find the very last cell in the column.

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save