# Need code to make circle within VB and place in Excel cell with number in middle of circle

I have an Excel worksheet that lists the risks on our program.  I am developing a risk matrix within another Excel worksheet to depict the ranking of the risks.  I want to place a circle within certain cells that depict the ranking of the risk (occurance/impact) along with the number of the risk embedded in the circle.  Is it possible to do that?  Or do I need to put the number beside the circle?  If so, could you provide example code that will do that?
###### Who is Participating?

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Commented:
Could you post a sample workbook? Can't quite visualise what you want to do. You can certainly put text inside a circle.
0
Author Commented:
The risk matrix is in a separate worksheet.  I want to draw a circle in the appropriate cell in the risk matrix according to the ranking of the risk (likelihood and consequence values).  I also want to extract the number from the risk number and put inside the circle (1,2,3,4).
Risk-Matrix.pdf
Risks.pdf
0
Commented:
Can you post an Excel workbook?
0
Author Commented:
RIO-Mgmt-test.xlsm
0
Commented:
What I was after was some indication of the results you were envisaging. Can you add that?
0
Author Commented:
Yes, I apologize, please see attached.
RIO-Mgmt-test.xlsm
0
Commented:
I see now. Presumably if you have more than one entry in a square you want the ovals regularly spaced?
0
Commented:
To add to this, how many are likely to be in any square - is there a theoretical or practical limit?
0
Commented:
I had a play and came up with this. It will accommodate 9 ovals in any square, but I guess could be adjusted:
``````Sub Macro2()

Dim r As Range, s As Shape, r1 As Range, v(1 To 5, 1 To 5), x As Double, y As Double

For Each r In Sheet1.Range("C2", Sheet1.Range("C" & Rows.Count).End(xlUp))
If Not IsEmpty(r) Then
v(r.Value, r.Offset(, 1).Value) = v(r.Value, r.Offset(, 1).Value) + 1
Set r1 = Sheet4.Range("B24").Offset(-4 * (r.Offset(, 1)), r * 2 - 1)
Select Case v(r.Value, r.Offset(, 1).Value)
Case 1 To 3: y = 0
Case 4 To 6: y = 1
Case 7 To 9: y = 2
End Select
Select Case v(r.Value, r.Offset(, 1).Value)
Case 1, 4, 7: x = 0
Case 2, 5, 8: x = 1
Case 3, 6, 9: x = 2
End Select
Set s = Sheet4.Shapes.AddShape(msoShapeOval, r1.Left + x * 15, r1.Top + y * 15, 25, 15)
s.TextFrame.Characters.Text = Val(Replace(r.Offset(, -2), "R-", ""))
s.TextFrame.Characters.Font.Size = 8
End If
Next r

End Sub
``````
0

Experts Exchange Solution brought to you by