Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
Solved

# Dynamically grow two circles (in Excel)

Posted on 2014-03-25
Medium Priority
592 Views
In a previous post, I received excellent feedback on some calculations for "circles".   See URL below for additional details:
http://www.experts-exchange.com/Other/Math_Science/Q_28396172.html#a39953218

As a follow-on question, I now would like to dynamically "resize" the sizes of 2 circles.

Please see attached XLS with an example.   For this example XLS, I'm only using two sizes for the inner and outer circle (see drop-down values in cell B1 and B2.

Also, as indicated in notes section of this XLS, I must ensure that the inner circle will always be centered within the outer circle.

Can this be done in Excel?

EEH
DynamicCircles.xlsx
0
Question by:ExpExchHelp
• 7
• 4

LVL 3

Expert Comment

ID: 39953529
It can.  You will need to use a VBA macro that fires off when the cell is updated to modify the values of the circles.
0

Author Comment

ID: 39953542
englanddg -- any suggestions on the VBA code?   Thank you in advance!

EEH
0

LVL 39

Expert Comment

ID: 39954014
You can use something like this, adjusting from AlignTwoOnOne shpCircle1, shpCircle2 to AlignTwoOnOne shpCircle2, shpCircle1 whether you want to align on one shape or the other.

Thomas

``````Sub AlignCenters()
Dim shpCircle1 As Shape, shpCircle2 As Shape

Set shpCircle1 = ActiveSheet.Shapes("Oval 3")
Set shpCircle2 = ActiveSheet.Shapes("Oval 4")

AlignTwoOnOne shpCircle2, shpCircle1

'or use
'AlignTwoOnOne shpCircle1, shpCircle2

End Sub

Private Sub AlignTwoOnOne(shp1 As Shape, shp2 As Shape)
'center based on the outside shape being square

shp2.Left = shp1.Left - (shp2.Width - shp1.Width) / 2
shp2.Top = shp1.Top - (shp2.Height - shp1.Height) / 2

End Sub
``````
0

Author Comment

ID: 39954221
nutsch:

Thanks for taking a stab at the VBA code.   I've plugging it into the worksheet but I'm not sure how to link cell values in B1 and B2 so that a) sizes will increase or decrease and b) green circle is aligned with red circle.

Any thoughts on how to get this accomplished?   See attached XLS for more details.

EEH
DynamicCirclesWithVBA.xlsm
0

LVL 39

Accepted Solution

nutsch earned 2000 total points
ID: 39954237
Use this code in your worksheet module:

Thomas

``````Private Sub Worksheet_Change(ByVal Target As Range)

'turn off updates to speed up code execution
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

If Not Intersect(Target, Range("B1:B2")) Is Nothing Then

ActiveSheet.Shapes("Oval 1").Height = [b1] * 100
ActiveSheet.Shapes("Oval 1").Width = [b1] * 100
ActiveSheet.Shapes("Oval 2").Height = [b2] * 100
ActiveSheet.Shapes("Oval 2").Width = [b2] * 100

If Not Intersect(Target, Range("B1")) Is Nothing Then
AlignTwoOnOne ActiveSheet.Shapes("Oval 2"), ActiveSheet.Shapes("Oval 1")
Else
AlignTwoOnOne ActiveSheet.Shapes("Oval 1"), ActiveSheet.Shapes("Oval 2")
End If

End If

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

End Sub

Private Sub AlignTwoOnOne(shp1 As Shape, shp2 As Shape)
'center based on the outside shape being square

shp2.Left = shp1.Left - (shp2.Width - shp1.Width) / 2
shp2.Top = shp1.Top - (shp2.Height - shp1.Height) / 2

End Sub
``````
0

Author Comment

ID: 39954809
nutsch:

I've added the code to the worksheet.   Names are "Oval 1" and "Oval 2".

Still, at this time, the shape sizes don't change when modifying the values in cells B1:B2.

EEH
DynamicCirclesWithVBA-v02.xlsm
0

LVL 39

Expert Comment

ID: 39954817
You've put the code in the workbook module rather than the worksheet module. Move it to the Dynamic Circles sheet code and it should work just fine.

Thomas
0

Author Comment

ID: 39954966
nutsch:

VERY IMPRESSIVE SOLUTION!!!   Thousand thanks!

EEH
0

Author Closing Comment

ID: 39954967
MOST EXCELLENT SOLUTION!
0

LVL 39

Expert Comment

ID: 39954994

Thomas
0

Author Comment

ID: 39956002
nutsch:

Quick follow-up question....

I'm integrating the solution (growing circles) into an existing Excel file/project.   Here are the steps that I performed (as part of integration) but something is missing (thus circles don't grow in project file).

1. Inserted two ovals (ensured they're called "Oval 1" and "Oval 2")
2. Copied VBA code into same worksheet
3. Save file as macro-enabled (given other requirements in project) XLS (i.e., XLSM).

When changing cell values, however, the circles' sizes don't changes.   Is there another "connecting" piece that must be integrated?

EEH
0

Author Comment

ID: 39956026
Thomas:

Never mind the last question... I figured it out.

EEH
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaacâ€¦
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201â€¦
###### Suggested Courses
Course of the Month11 days, 12 hours left to enroll