update code to highlight item is existed in column by inputbox

[MKLAQ]

hello

I would update this code after show message the item is found in specific row ,then should highlight item in column B , and if it shows the second message the item is not found ,then should not highlighted . with considering when run the inputbox from the first time before writing item then should delete color is already highlighted cells .

this code for Dave

Sub CommandButton2_Click()
Dim Search          As Variant
Dim c               As Range
Dim sh              As Worksheet
Dim Response        As VbMsgBoxResult
   
Dim msg             As String, FirstAddress As String
Dim Prompts(1 To 2) As String, Prompt As String
   
Prompts(1) = "Serial number found On row(s) " & Chr(10) & Chr(10)
Prompts(2) = "Serial number Not found" & Chr(10) & Chr(10)
   
Set sh = ThisWorkbook.Worksheets("list1")
   
Do
'display inputbox
Do
Search = InputBox("Enter Search Number Value:", "Search")
'cancel pressed
If StrPtr(Search) = 0 Then Exit Sub
Loop Until Len(Search) > 0
If IsNumeric(Search) Then Search = Val(Search)

       
Set c = sh.Columns(2).Find(What:=Search, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
If Not c Is Nothing Then
FirstAddress = c.Address
msg = Prompts(1)
Do
msg = msg & c.Row & Chr(10)
Set c = sh.Columns(2).FindNext(c)

If c Is Nothing Then Exit Do
Loop Until FirstAddress = c.Address
Else
msg = Prompts(2) & Search & Chr(10)
End If
       
Response = MsgBox(msg & Chr(10) & "Do you want To make another search?", 36, "Results")
msg = ""
Loop Until Response = vbNo
   
End Sub

thanks

 

[DanteAmor]

Try this:

Sub CommandButton2_Click()
  Dim Search          As Variant
  Dim c               As Range, rng As Range
  Dim sh              As Worksheet
  Dim Response        As VbMsgBoxResult
  Dim msg             As String, FirstAddress As String
  Dim Prompts(1 To 2) As String, Prompt As String
     
  Prompts(1) = "Serial number found On row(s) " & Chr(10) & Chr(10)
  Prompts(2) = "Serial number Not found" & Chr(10) & Chr(10)
  Set sh = ThisWorkbook.Worksheets("list1")
  Set rng = sh.Range("B:B")
  
  Do
    rng.Interior.Color = xlNone
    Do    'display inputbox
      Search = InputBox("Enter Search Number Value:", "Search")
      If StrPtr(Search) = 0 Then Exit Sub 'cancel pressed
    Loop Until Len(Search) > 0
    
    If IsNumeric(Search) Then Search = Val(Search)
    Set c = rng.Find(Search, , xlValues, xlWhole, xlByRows, xlNext, True)
    If Not c Is Nothing Then
      FirstAddress = c.Address
      msg = Prompts(1)
      Do
        c.Interior.Color = vbYellow
        msg = msg & c.Row & Chr(10)
        Set c = rng.FindNext(c)
      Loop While Not c Is Nothing And FirstAddress <> c.Address
    Else
      msg = Prompts(2) & Search & Chr(10)
    End If
           
    Response = MsgBox(msg & Chr(10) & "Do you want To make another search?", 36, "Results")
    msg = ""
  Loop Until Response = vbNo
End Sub

 

[MKLAQ]

fantastic ! just need fixing the header . the code deletes the color in header when delete the other cells

 

[DanteAmor]

just need fixing the header

Change this line:

Set rng = sh.Range("B:B")

For this (Assuming the header is in row 1):

Set rng = sh.Range("B2:B" & Rows.Count)

 

[MKLAQ]

Great ! thanks so much

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.