PDA

View Full Version : [SOLVED] Deleting Ovals - Logic: If they are above row 70



Daxton A.
10-25-2018, 11:13 PM
I have a worksheet that has a macro that's button activated and it draws an oval around the cell that is selected.
I also have another button that databases all the information on the sheet and copies the cell with the oval.
Now the problem comes when I select my Clear button macro because I have the code line:

ActiveSheet.Ovals.Delete and that clears my database of ovals & I am needing the logic to delete
the ovals down to row 69 and leave rows 70+ alone.

Is it possible to achieve this goal without having another worksheet?



Sub My_Circle()
Dim x, y As Single, area, oldrange As Range

'set starting cell
Set oldrange = Selection.Cells(1)

'rotate through areas - this allows multiple circles to be drawn
For Each area In Selection.Areas
With area
' x and y are numbers that are a function of the
' area's height and width
x = .Height * 0.1
y = .Width * 0.1
ActiveSheet.Ovals.Add Top:=.Top - x, Left:=.Left - y, _
Height:=.Height + 2 * x, Width:=.Width + 1.5 * y
With ActiveSheet.Ovals(ActiveSheet.Ovals.Count)
.Interior.ColorIndex = xlNone
.ShapeRange.Line.Weight = 1.25
End With
End With

'Bold the ActiveCell
If ActiveCell.Font.Bold = True Then
ActiveCell.Font.Bold = False
Else
ActiveCell.Font.Bold = True
End If

Next area

oldrange.Select

End Sub

Paul_Hossler
10-26-2018, 07:20 AM
Try this





Option Explicit


Sub DeleteOvalsAbove70()
Dim iShapes As Long

For iShapes = ActiveSheet.Shapes.Count To 1 Step -1
With ActiveSheet.Shapes(iShapes)
If .Type = msoAutoShape Then
If .AutoShapeType = msoShapeOval Then
If .TopLeftCell.Row < 70 Then
.Delete
End If
End If
End If
End With

Next iShapes
End Sub

Daxton A.
10-27-2018, 08:59 PM
Right on Paul, worked beautifully...Thanks a bunch!!!