add red oval shape into same row contain name based on inputbox user

[Mussa]

hi
today I got assistance from @DanteAmor about add oval shape to selected range from this thread
how add red oval shapes around the values based on selected range or separated cells
now I want doing that by input box user should search name based on column B and when find the name should add oval shape in the same row for each cell is relating of the name
see the pic 1 when write name input box and pic2 the result should be
i try adjusting the code , but not succeed so far .

Sub AddRedOval()
  Dim shp As Shape
  Dim c As Range, r As Range
  Dim Value As Variant
  ActiveSheet.DrawingObjects.Delete
  Value = InputBox("Enter Value:", "Input")
Set r = Sheets(sheet1).Columns("B:B").Find(What:=Value, LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=True, SearchFormat:=False)
  'Set r = Selection
  For Each c In r
    If c.Value <> "" Then
      Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height)
      shp.Fill.Transparency = 1
      shp.Line.ForeColor.RGB = RGB(255, 0, 0)
      shp.Line.Weight = 1
    End If
  Next
End Sub

 

[mackc557]

What is happening when you run this? An error code? Not circling the correct cells?

 

[Mussa]

it shows error subsript out of range