Here is a way using A filter MacroCheck out the Example![]()
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
Bookmarks