Thermometer Chart

     

  • This workbook enables the user to create thermometer chart by using vba macors
  • Click on below mentioned image to watch video
  •  

    Download The Workbook

    Public ch As ChartObject, sh As Worksheet
    Function DefineWorksheet()
    Set sh = ThisWorkbook.Sheets("CreateChart_VBA")
    sh.Activate
    Application.ActiveWindow.DisplayGridlines = False
    End Function
    Function Createchart()
    With sh.Range("D2:L18")
    Set ch = sh.ChartObjects.Add( _
    Height:=.Height, _
    Top:=.Top, _
    Left:=.Left, _
    Width:=.Width)
    End With
    End Function
    Sub CreateChrat()
    DefineWorksheet
    Createchart
    With ch.Chart
    .ChartType = xlColumnClustered
    '=================Series Collection 1 ==========Standard====
    .SeriesCollection.NewSeries
    Dim Standard As Series
    Set Standard = .SeriesCollection(1)
    Standard.Name = sh.Range("B1").Value
    Standard.Values = sh.Range("B2:B6")
    Standard.XValues = sh.Range("A2:A6")
    Standard.Interior.ColorIndex = 5
    'Standard.HasDataLabels = True
    '=================Series Collection 2==Actual ===========
    .SeriesCollection.NewSeries
    Dim Actual As Series
    Set Actual = .SeriesCollection(2)
    Actual.Name = sh.Range("C1").Value
    Actual.Values = sh.Range("C2:C6")
    'Actual.XValues = sh.Range("B5:B9")
    Actual.Interior.ColorIndex = 30
    '=======Overlap Actual into Standard==================
    Actual.Select
    'ActiveChart.FullSeriesCollection(2).Select
    ActiveChart.ChartGroups(1).Overlap = 100
    ActiveChart.FullSeriesCollection(1).Select
    Selection.Format.Fill.Visible = msoFalse
    Actual.Format.Line.Visible = msoFalse
    Standard.Format.Line.Weight = 2.5
    Standard.Format.Line.Visible = msoTrue
    Standard.Format.Line.ForeColor.RGB = RGB(192, 0, 0)
    '.Legend.Position = xlLegendPositionRight

    '==============DataLabels===================
    Dim S As Series
    For i = 1 To .SeriesCollection.Count
    Set S = .SeriesCollection(i)
    S.HasDataLabels = True
    S.ApplyDataLabels xlDataLabelsShowValue
    Dim DataLble As DataLabels
    Set DataLble = S.DataLabels
    DataLble.Font.Size = 11
    DataLble.Font.Bold = True
    DataLble.Font.Name = "Calibri"
    DataLble.Orientation = xlHorizontal
    If i = 1 Then
    DataLble.Position = xlLabelPositionOutsideEnd
    DataLble.Font.ColorIndex = 5
    Else:
    DataLble.Position = xlLabelPositionCenter
    DataLble.Font.ColorIndex = 2
    End If
    Next
    '===============Chart Title===============
    'Chart Title
    .HasTitle = True
    Dim t As ChartTitle
    Set t = .ChartTitle
    t.Text = sh.Range("B1").Value & " - " & sh.Range("C1").Value & " - " & "Sales"
    t.Font.ColorIndex = 30
    t.Font.Size = 25
    t.Font.FontStyle = "Footlight MT Light"
    '=====================Legend Position=========
    .HasLegend = True
    Dim L As Legend
    Set L = .Legend
    L.Position = xlLegendPositionTop
    '=================ChartArea===========
    Dim SeriesAxis As Axis
    Set SeriesAxis = .Axes(xlValue, xlPrimary)
    SeriesAxis.HasTitle = True
    SeriesAxis.AxisTitle.Caption = "Sales"
    SeriesAxis.AxisTitle.Characters.Font.ColorIndex = 5
    SeriesAxis.AxisTitle.Characters.Font.Size = 15
    SeriesAxis.AxisTitle.Orientation = 90
    SeriesAxis.HasMinorGridlines = False
    SeriesAxis.HasMajorGridlines = False

    '=================Category axis format===============
    Dim CategoryAxis As Axis
    Set CategoryAxis = .Axes(xlCategory)
    CategoryAxis.HasTitle = True
    CategoryAxis.AxisTitle.Caption = "Items"
    CategoryAxis.AxisTitle.Characters.Font.ColorIndex = 5
    CategoryAxis.AxisTitle.Characters.Font.Size = 15
    '=======Category axis TickLabels=================
    Dim CategoryAxisTK As TickLabels
    Set CategoryAxisTK = .Axes(xlCategory).TickLabels
    CategoryAxisTK.Font.ColorIndex = 5
    CategoryAxisTK.Orientation = 45
    End With
    ch.Name = "SalesData"
    sh.Range("A1").Select
    End Sub