how add red oval shapes around the values based on selected range or separated cells

[Mussa]

hello
I would add red oval shape into cells based on select the range or specific separated cells which contains any value .
see some picture when select some ranges or cells .with considering the oval shape doesn't be outside the cell should fit into cell

expected result

thanks

 

[DanteAmor]

Try this:

Sub AddRedOval()
  Dim shp As Shape
  Dim c As Range, r As Range
  
  ActiveSheet.DrawingObjects.Delete
  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

 

[Mussa]

very excellent ! but I need when I select specific cells and highlighted and move to others selected cells when higlighted the new selected cell .shouldn't delete the shape from old selected cell . every time select cell should add the shape . it deosn't delete it except in one cas as the code does when I don't select cell then it delete all shape from all cells have been selected .

 

[DanteAmor]

Delete this line and try again

ActiveSheet.DrawingObjects.Delete

 

[Mussa]

many thanks buddy

 

[DanteAmor]

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