# Nightingale Rose Diagram Excel Template

Nightingale Rose Diagram is the most famous statistical diagram. It's a form of the Pie Chart now known as the Polar Area Diagram. We often see it in the Business Magazines, Newspapers and Journal of Finance. In this tutorials, I'll show you two styles of Nightingale Rose Diagram Template use Excel VBA.

## Nightingale Rose Diagram Template Style 1

### Final results

Very cool? Yes! In this style, we use Facebook social demographics 2010 data. You can compare this diagram with Digital Surgeons's post.

### VBA Code

```Sub RoseDiagram1()
Dim i%, j%, k%, n%, m%
Dim arr
Dim MyShapes() As Variant
Dim ObjRange As Object, ObjShape As Object
Dim MaxRow As Integer
Dim MaxCol As Integer

On Error Resume Next
ActiveSheet.Shapes("group1").Delete
Erase MyShapes
Application.ScreenUpdating = False
arr = ActiveSheet.Range("A1").CurrentRegion
MaxRow = UBound(arr, 1) - 1
MaxCol = UBound(arr, 2)
ReDim MyShapes(1 To MaxCol * MaxRow)
n = 1

For i = 1 To MaxCol
j = 17
Do While Cells(j, i) <> ""

Set ObjShape = ActiveSheet.Shapes.AddShape(msoShapePie, 400, 700, 150, 150) 'You may change the shape parameters
With ObjShape
.LockAspectRatio = msoTrue
.Fill.ForeColor.RGB = Cells(j, i).Interior.Color
.Line.ForeColor.RGB = RGB(128, 128, 128) 'You may change the line forecolor
.Line.Weight = 1
.Line.Visible = msoTrue
.Adjustments.Item(2) = 360 / MaxCol - 90
.Rotation = 360 / MaxCol * (i - 1)
.ScaleHeight (0.4 + Cells(j, i)) / 0.7, msoFalse, msoScaleFromTopLeft
For k = 1 To j - 1
.ZOrder msoSendBackward
Next
End With
MyShapes(n) = ObjShape.Name

n = n + 1
j = j + 1
Loop
Next
n = n - 1

Set ObjShape = ActiveSheet.Shapes.AddShape(msoShapeFlowchartConnector, 400, 700, 320, 320) 'You may change the shape parameters
With ObjShape
.Line.ForeColor.RGB = Cells(13, 2).Interior.Color
.Line.Weight = 4 'You may change the line weight
.Fill.Visible = msoFalse
MyShapes(n + 2) = .Name
End With

Set ObjShape = ActiveSheet.Shapes.AddShape(msoShapeArc, 400, 700, 40, 40) 'You may change the shape parameters
With ObjShape
.Line.ForeColor.RGB = RGB(50, 50, 50) 'You may change the line forecolor
.Line.Weight = 4
.Fill.ForeColor.RGB = Cells(13, 4).Interior.Color
.ZOrder msoSendTotop
MyShapes(n + 3) = .Name
End With

Set ObjRange = ActiveSheet.Shapes.Range(MyShapes)
With ObjRange
.Align msoAlignLefts, msoFalse
.Align msoAlignTops, msoFalse
.Align msoAlignCenters, msoFalse
.Align msoAlignMiddles, msoFalse
.Group
.Name = "group1"
.ZOrder msoSendToBack
End With

Application.ScreenUpdating = True
End Sub
```

To use this template, you should have some Excel VBA knowledges. Click here to download this Excel template. (Note: support Excel 2007 - 2013)

## Nightingale Rose Diagram Template 2

### Final results

In this style, we use China vs. US compare data to create this Rose Diagram. You can compare this diagram with here.

### VBA Code

```Sub RoseDiagram2()

Dim i%, j%, k%, n%
Dim arr, brr
Dim ObjRange As Object, ObjShape As Object
Dim MyShapes() As Variant
Dim Ws As Worksheet, BName As String

On Error Resume Next
ActiveSheet.Shapes("group2").Delete
Erase MyShapes
Application.ScreenUpdating = False
arr = ActiveSheet.Range("A1").CurrentRegion
MaxCol = UBound(arr, 2) - 1
ReDim MyShapes(1 To MaxCol * 2 + 3)
n = 1
For i = 1 To MaxCol
For k = 6 To 7

Set ObjShape = ActiveSheet.Shapes.AddShape(msoShapeArc, 400, 200, 250, 250) 'You may change the shape parameters
With ObjShape
.LockAspectRatio = msoTrue
.Fill.ForeColor.RGB = Cells(k, 1).Interior.Color
.Line.Visible = msoFalse
.Adjustments.Item(2) = 360 / (2 * MaxCol + 1) - 90
.Rotation = (360 / MaxCol) * (i - 1) + (k - 6) * (90 / MaxCol)
.ScaleHeight Cells(k, i + 1), msoFalse, msoScaleFromTopLeft
If Cells(k, i + 1) = 1 Then .ZOrder msoSendToBack
MyShapes(n) = ObjShape.Name
n = n + 1
End With
Next
Next
n = n - 1
Set ObjShape = ActiveSheet.Shapes.AddShape(msoShapeArc, 400, 200, 43, 43) 'You may change the shape parameters
With ObjShape
.Fill.ForeColor.RGB = RGB(255, 255, 255) 'You may change this
.Line.Visible = msoFalse
MyShapes(n + 1) = .Name
End With
Set ObjShape = ActiveSheet.Shapes.AddShape(msoShapeArc, 400, 200, 35, 35) 'You may change the shape parameters
With ObjShape
.Fill.ForeColor.RGB = Cells(6, 1).Interior.Color
.Line.Visible = msoFalse
.Rotation = -90
MyShapes(n + 2) = .Name
End With
Set ObjShape = ActiveSheet.Shapes.AddShape(msoShapeArc, 400, 200, 35, 35) 'You may change the shape parameters
With ObjShape
.Fill.ForeColor.RGB = Cells(7, 1).Interior.Color
.Line.Visible = msoFalse
.Rotation = 90
MyShapes(n + 3) = .Name
End With
Set ObjRange = ActiveSheet.Shapes.Range(MyShapes)
With ObjRange
.Align msoAlignLefts, msoFalse
.Align msoAlignTops, msoFalse
.Align msoAlignCenters, msoFalse
.Align msoAlignMiddles, msoFalse
.Group
.Name = "group2"
.ZOrder msoSendToBack
End With
Application.ScreenUpdating = True
End Sub
```

To use this template, you should have some Excel VBA knowledges. Click here to download this Excel template. (Note: support Excel 2007 - 2013)

1. João

• Justin
2. Elise

Thanks. It’s really pretty diagram.

3. Joyce

How do I add more country in Nightingale Rose Diagram Template 2?

4. Ashfaq Bhutto

Very cool. I was looking for this. Thank you

5. George Beniac

Hi, is there a way to add the data labels in?

6. joe

is it possible to add error bars?

7. zhong sir

NB，3Q very much！！！