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
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