Creating Taylor Diagrams in Excel

D

davidhall

Board Regular
Joined
Mar 6, 2011
Messages
174
I'm trying to create a Taylor Diagram using excel and I'm looking to see if someone knows where I can obtain a template and/or instructions on how to do it.

Any help is much appreciated.
 
Sort by date Sort by votes
My code relies on many default settings. It looks like not using "markers" everywhere is one of those settings. You must have done some plotting that made a change somewhere.

My most recent code is intended to be an Add-In but I have not found a good way to publish that yet but you could try an update to the code. I have made the "Demo" option a bit more useful as well.

Try removing all the code from the a_ProcessForm Module and replacing it with this:
Code: 
Option Explicit

Sub ProcessForm()

    Dim r As Range
    Dim rHdg As Range
    Dim TD As c_TaylorDiagram
    Dim arr As Variant
    Dim i As Long
    Dim rc As Variant
    Dim frmErr As f_okOrDemo
    Set r = Range("L1")
    If Not r Is Nothing Then
        ' Display the Row Headings
        Set rHdg = r.Resize(10)
        With rHdg
            .Value = Application.Transpose(Array("Chart Title", "Axis Title", "Rays", "SD Arcs", "Err Arcs  +/-", "SD Max", "Observed", "Labels", "Std Dev", "Correlation"))
            .Font.Bold = True
            .Columns(1).EntireColumn.AutoFit
            .Interior.Color = RGB(245, 245, 245)
        End With
        ' Check for missing data
        For i = 1 To 10
            If r.Cells(i, 2).Value = vbNullString Then
                Set frmErr = New tdDiagram.f_okOrDemo
                frmErr.Show
                If Not frmErr.Demo Then Exit Sub
                rHdg(1, 2).Value = Array("My Title")
                rHdg(2, 2).Value = Array("SD Axis")
                rHdg(3, 2).Resize(, 7).Value = Array(0.2, 0.4, 0.6, 0.8, 0.9, 0.95, 0.99)
                rHdg(4, 2).Resize(, 6).Value = Array(0.2, 0.4, 0.6, 0.8, 1.2, 1.4)
                rHdg(5, 2).Resize(, 2).Value = Array(0.2, 0.4)
                rHdg(6, 2).Resize(, 1).Value = Array(1.5)
                rHdg(7, 2).Resize(, 1).Value = Array(1)
                rHdg(8, 2).Resize(, 4).Value = Array("Obs", "A", "B", "C")
                rHdg(9, 2).Resize(, 4).Value = Array(1#, 0.8, 0.7, 1#)
                rHdg(10, 2).Resize(, 4).Value = Array(1#, 0.95, 0.93, 0.9)
            End If
        Next
        ' Draw Diagram
        Set TD = New tdDiagram.c_TaylorDiagram
        With TD
            .ChartTitle = r.Cells(1, 2).Value
            .AxisTitle = r.Cells(2, 2).Value
            .Rays = Range(r.Cells(3, 1), r.Cells(3, 1).End(xlToRight)).Value
            .Arc1 = Range(r.Cells(4, 1), r.Cells(4, 1).End(xlToRight)).Value
            .Arc2 = Range(r.Cells(5, 1), r.Cells(5, 1).End(xlToRight)).Value
            .StdMax = r.Cells(6, 2).Value
            .StdRef = r.Cells(7, 2).Value
            .Labels = Range(r.Cells(8, 1), r.Cells(8, 1).End(xlToRight)).Value
            .stddev = Range(r.Cells(9, 1), r.Cells(9, 1).End(xlToRight)).Value
            .correlation = Range(r.Cells(10, 1), r.Cells(10, 1).End(xlToRight)).Value
            .drwChart
        End With
     End If
Cancel:
    Set TD = Nothing
End Sub

Sub GUIProcessForm(control As IRibbonControl)
    ProcessForm
End Sub
Then go to the c_TaylorDiagram Module (Class) and replacing the code with this:
Code: 
Option Explicit

Const Rad2Deg As Double = 57.2957795130823

Private p_Chart As Chart
Private p_ChartTitle As String
Private p_AxisTitle As String
Private p_Rays As Variant
Private p_Arc1 As Variant
Private p_Arc2 As Variant
Private p_StdMax As Double
Private p_StdRef As Double
Private p_Labels As Variant
Private p_StdDev As Variant
Private p_Correlation As Variant


Public Sub drwChart()
    Dim newChart As Shape
    Dim i As Long
    
    Set newChart = ActiveWorkbook.ActiveSheet.Shapes.AddChart(xlXYScatterLinesNoMarkers, Left:=0, Top:=0, Width:=500, Height:=500)
    Set Me.sh = newChart.Chart
    With newChart.Chart
        .HasTitle = True
        .ChartTitle.Text = Me.ChartTitle
        .HasLegend = False
        
        With .PlotArea
            .InsideWidth = .InsideHeight
            .Width = 450
            .Left = 20
            .Height = 450
        End With
        
        With .Axes(xlValue)
            .MaximumScale = Me.StdMax + (Me.StdMax / 15)
            .MinimumScale = 0
            .MajorGridlines.Delete
            .HasTitle = True
            With .AxisTitle
                .Text = Me.AxisTitle
                .Font.Size = 12
            End With
        End With
        
        With .Axes(xlCategory)
            .MaximumScale = Me.StdMax + (Me.StdMax / 15)
            .MinimumScale = 0
            .MajorGridlines.Delete
            .HasTitle = True

            With .AxisTitle
                .Text = Me.AxisTitle
                .Font.Size = 12
            End With
            
        End With
        
        For i = .SeriesCollection.Count To 1 Step -1
            .SeriesCollection(i).Delete
        Next
        
    End With
    
    ' Draw the Chart

    For i = 2 To UBound(Me.Rays, 2)
        Call addRays(CDbl(Me.Rays(1, i)))
    Next
    
    For i = 2 To UBound(Me.Arc1, 2)
        Call drwArc(CDbl(Me.Arc1(1, i)), 0, 1, msoLineDash)
    Next
    
    Call drwArc(Me.StdRef, 0, 1, msoLineLongDashDot)
    
    For i = 2 To UBound(Me.Arc2, 2)
        Call drwArc(CDbl(Me.Arc2(1, i)), Me.StdRef, 1, msoLineRoundDot)
    Next
    
    For i = 2 To UBound(Me.stddev, 2)
        Call addPoint(CDbl(Me.stddev(1, i)), CDbl(Me.correlation(1, i)), CStr(Me.Labels(1, i)))
    Next
    
    addScale
    
End Sub

Public Property Set sh(Value As Chart)
    Set p_Chart = Value
End Property
Public Property Get sh() As Chart
    Set sh = p_Chart
End Property

Public Property Let ChartTitle(Value As String)
    p_ChartTitle = Value
End Property
Public Property Get ChartTitle() As String
    ChartTitle = p_ChartTitle
End Property

Public Property Let AxisTitle(Value As String)
    p_AxisTitle = Value
End Property
Public Property Get AxisTitle() As String
    AxisTitle = p_AxisTitle
End Property

Public Property Let Rays(Value As Variant)
    p_Rays = Value
End Property
Public Property Get Rays() As Variant
    Rays = p_Rays
End Property

Public Property Let Arc1(Value As Variant)
    p_Arc1 = Value
End Property
Public Property Get Arc1() As Variant
    Arc1 = p_Arc1
End Property

Public Property Let Arc2(Value As Variant)
    p_Arc2 = Value
End Property
Public Property Get Arc2() As Variant
    Arc2 = p_Arc2
End Property

Public Property Let StdMax(Value As Variant)
    p_StdMax = Value
End Property
Public Property Get StdMax() As Variant
    StdMax = p_StdMax
End Property

Public Property Let StdRef(Value As Variant)
    p_StdRef = Value
End Property
Public Property Get StdRef() As Variant
    StdRef = p_StdRef
End Property

Public Property Let Labels(Value As Variant)
    p_Labels = Value
End Property
Public Property Get Labels() As Variant
    Labels = p_Labels
End Property

Public Property Let stddev(Value As Variant)
    p_StdDev = Value
End Property
Public Property Get stddev() As Variant
    stddev = p_StdDev
End Property

Public Property Let correlation(Value As Variant)
    p_Correlation = Value
End Property
Public Property Get correlation() As Variant
    correlation = p_Correlation
End Property

Public Sub drwArc(rad As Double, x0 As Double, weight As Single, dashstyle As Long)
    
    Dim i As Long
    Dim sr As Series
    Dim xd As Double
    Dim yd As Double
    Dim x As Double

    ReDim arrX(0 To 100)
    ReDim arrY(0 To 100)
    
    For i = 1 To UBound(arrX)
        x = 2 * (i - (UBound(arrX) / 2))
        xd = x0 + rad * Sin(x / Rad2Deg)
        yd = rad * Cos(x / Rad2Deg)
        If xd > -0.01 Then
            If x0 > 0 And (xd ^ 2 + yd ^ 2) ^ 0.5 > (Me.StdMax * 1.001) Then Exit For
            arrX(i) = xd
            arrY(i) = yd
        End If
    Next

    With Me.sh
        Set sr = .SeriesCollection.NewSeries
        With sr
            .XValues = arrX
            .Values = arrY
            .MarkerStyle = xlMarkerStyleNone
            With .Format.Line
                .ForeColor.RGB = RGB(0, 0, 0)
                .dashstyle = dashstyle
                .weight = weight
            End With
        End With
    End With
    
End Sub

Public Sub addRays(cor As Double)

    Dim sr As Series
    Dim r As Double
    Dim x As Double
    Dim arrX As Variant
    Dim arrY As Variant
    
    With Me.sh
        
        ' Draw radial lines
        r = Me.StdMax
    
        ReDim arrX(1 To 2)
        ReDim arrY(1 To 2)

        arrX(1) = (r * cor)
        arrY(1) = r * Sin(WorksheetFunction.Acos(cor))
        arrX(2) = 0
        arrY(2) = 0
        Set sr = .SeriesCollection.NewSeries
        With sr
            .HasDataLabels = False
            .XValues = arrX
            .Values = arrY
            .MarkerStyle = xlMarkerStyleNone
            With .Format.Line
                .Visible = True
                .ForeColor.RGB = RGB(200, 200, 200)
                .dashstyle = msoLineSolid
                .weight = 1
            End With
        End With

    End With
End Sub

Sub addScale()

    Dim i As Long
    Dim sr As Series
    Dim r As Double
    Dim x As Double
    Dim xd As Double
    Dim yd As Double
    Dim arrScale As Variant
    Dim arrAngle As Variant
    Dim arrTick As Variant
    Dim arrX As Variant
    Dim arrY As Variant
    Dim dl As DataLabel
    
    With Me.sh
    
        arrScale = Array("0.0", "0.1", "0.2", "0.3", "0.4", "0.5", "0.6", "0.7", "0.8", "0.9", "0.95", "0.99", "1.0")
        arrAngle = Array(0, 5.74, 11.54, 17.46, 23.58, 30, 36.87, 44.43, 53.3, 64.16, 71.81, 81.89, 90)

        ' Draw major tick marks
        r = Me.StdMax
          
        ReDim arrX(1 To 2)
        ReDim arrY(1 To 2)
        
        For i = LBound(arrAngle) To UBound(arrAngle)
            x = arrAngle(i)
            arrX(1) = (r * Sin(x / Rad2Deg))
            arrY(1) = r * Cos(x / Rad2Deg)
            arrX(2) = 0.97 * (r * Sin(x / Rad2Deg))
            arrY(2) = 0.97 * (r * Cos(x / Rad2Deg))
            Set sr = .SeriesCollection.NewSeries
            With sr
                .HasDataLabels = False
                .XValues = arrX
                .Values = arrY
                .MarkerStyle = xlMarkerStyleNone
                With .Format.Line
                    .Visible = True
                    .ForeColor.RGB = RGB(0, 0, 0)
                    .dashstyle = msoLineSolid
                    .weight = 2
                End With
            End With
        Next
        
        ' Draw minor tick marks
        arrTick = Array(2.87, 8.63, 14.48, 20.49, 26.74, 33.37, 40.54, 48.59, 58.21, 65.51, 66.93, 68.43, 70.05, 73.74, 75.93, 78.52)
        r = Me.StdMax
          
        ReDim arrX(1 To 2)
        ReDim arrY(1 To 2)
        
        For i = LBound(arrTick) To UBound(arrTick)
            x = arrTick(i)
            arrX(1) = (r * Sin(x / Rad2Deg))
            arrY(1) = r * Cos(x / Rad2Deg)
            arrX(2) = 0.98 * (r * Sin(x / Rad2Deg))
            arrY(2) = 0.98 * (r * Cos(x / Rad2Deg))
            Set sr = .SeriesCollection.NewSeries
            With sr
                .HasDataLabels = False
                .XValues = arrX
                .Values = arrY
                .MarkerStyle = xlMarkerStyleNone
                With .Format.Line
                    .Visible = True
                    .ForeColor.RGB = RGB(0, 0, 0)
                    .dashstyle = msoLineSolid
                    .weight = 1.5
                End With
            End With
        Next
                
        ' Draw labels
        r = 1.04 * Me.StdMax
        
        ReDim arrX(LBound(arrAngle) To UBound(arrAngle))
        ReDim arrY(LBound(arrAngle) To UBound(arrAngle))
        
        For i = LBound(arrAngle) To UBound(arrAngle)
            x = arrAngle(i)
            arrX(i) = r * Sin(x / Rad2Deg)
            arrY(i) = r * Cos(x / Rad2Deg)
        Next

        Set sr = .SeriesCollection.NewSeries
        With sr
            .HasDataLabels = True
            .DataLabels.Font.Size = 12
            .XValues = arrX
            .Values = arrY
            .Format.Line.Visible = False
            .MarkerStyle = xlMarkerStyleNone
            For i = LBound(arrAngle) To UBound(arrAngle)
                With .Points(i + 1).DataLabel
                    .Text = arrScale(i)
                    .Orientation = 90 - arrAngle(i)
                    .Position = xlLabelPositionCenter
                End With
            Next
        End With
                
        ' Draw "Correlation"
        r = 1.1 * Me.StdMax
        
        ReDim arrX(1 To 2)
        ReDim arrY(1 To 2)
        
        x = 45
        arrX(1) = r * Sin(x / Rad2Deg)
        arrY(1) = r * Cos(x / Rad2Deg)
        arrX(2) = r * Sin(x / Rad2Deg)
        arrY(2) = r * Cos(x / Rad2Deg)

        Set sr = .SeriesCollection.NewSeries
        With sr
            .HasDataLabels = True
            .DataLabels.Font.Size = 12
            .XValues = arrX
            .Values = arrY
            .Format.Line.Visible = False
            .MarkerStyle = xlMarkerStyleNone
            For i = LBound(arrAngle) To UBound(arrAngle)
                With .Points(1).DataLabel
                    .Text = "Correlation"
                    .Orientation = -45
                    .Position = xlLabelPositionCenter
                    .Font.Size = 14
                End With
                .Points(2).DataLabel.Text = ""
            Next
        End With

    End With
    Call drwArc(Me.StdMax, 0, 2, msoLineSolid)
End Sub

Public Sub addPoint(stddev As Double, correlation As Double, symbol As String)

    Dim sr As Series
    Dim r As Double
    Dim arrX As Variant
    Dim arrY As Variant
    
    With Me.sh
        
        Set sr = .SeriesCollection.NewSeries
        With sr
            .HasDataLabels = True
            .MarkerStyle = xlMarkerStyleCircle
            .XValues = stddev * correlation
            .Values = stddev * Sin(WorksheetFunction.Acos(correlation))
            .MarkerStyle = xlMarkerStyleCircle
            With .Points(1).DataLabel
                .Text = symbol
                .Position = xlLabelPositionAbove
                .Font.Size = 10
            End With
        End With
    End With
End Sub
You should probably make a copy first.

If it makes things better I will try and upload an updated version to my OneDrive site.


Regards,
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Hi and welcome to the MrExcel Message Board.

How far have you got? Do you have the workbook running? If so, do you see what is supposed to be a Taylor Diagram icon on the top right hand side of the Home menu?

If so, click it. It will display an error message with the option of a Demo. Pick Demo. I hope it will be clear from then on.

Come back if you need more info.

Regards,
 
Upvote 0
Hi Rick,

I am trying to plot the Taylor diagram with your provided excel sheet, but I am unable to change the plot with incorporating my stats data. Since I don't the steps to plot the diagram in excel, it is also because I couldn't get the procedure what you have mentioned here.

https://drive.google.com/file/d/0BzDSn8_trYXNTlY2TThucjB0SGs/view?usp=sharing

I have shared the link of my data file, could you please let me know how to get the diagram for each climate factor or help me plotting this?

Thanks,
RJ
 
Upvote 0
So, can you see the example charts in there?

If so have you tried overtyping the existing data with your data?

Does that produce a chart?

Regards,
 
Upvote 0
I tried to copy and paste my own data over the charts you have made, but it doesn't change anything in the Taylor Diagram.

Regards and Thanks
 
Upvote 0
Can you see an icon on the toolbar at the top of the screen on the right hand side in the "Taylor Chart" section marked "Draw"?

What happens if you push that after you have pasted in your data?


Regards,
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Sizing a check mark box?
Replies
2
Views
92
Fluff
Fluff
J
  • Question
Create multiple sheets based on Master sheet criteria
Replies
8
Views
327
mumps
mumps
M
  • Question
Excel spreadsheet - online as a interactive website - what to do next
Replies
1
Views
146
Rijnsent
Rijnsent
F
  • Question
VBA - Merge and bottons to click
Replies
1
Views
249
eiloken
E
N
  • Question
need min and max showing on a tornado diagram axis
Replies
5
Views
290
natK
N

Forum statistics

Threads
1,215,366
Messages
6,124,514
Members
449,168
Latest member
CheerfulWalker

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top