Friday, February 8, 2013

Create In-Cell Charts Using VBA for Data Visualization

If you want to create in-cell charts using VBA . Try this macro -

Sub create_charts()

    Dim i As Long
    Dim cht As Shape
    Dim sht As Worksheet
    Set sht = ThisWorkbook.Sheets("Data")
    'delete all exisitng charts
    For Each cht In sht.Shapes
        If cht.Type = msoChart Then
        End If
    ' run loop
    For i = 2 To sht.Range("a65356").End(xlUp).Row
        'call sub procedure to create charts
        Call add_charts_to_cell("'" & sht.Name & "'!" & sht.Range("b" & i & ":e" & i).Address, sht.Range("f" & i), xlBar, "'" & sht.Name & "'!" & sht.Range("b1:e1").Address)
        Call add_charts_to_cell("'" & sht.Name & "'!" & sht.Range("b" & i & ":e" & i).Address, sht.Range("g" & i), xlPie, "'" & sht.Name & "'!" & sht.Range("b1:e1").Address)

End Sub

Sub add_charts_to_cell(chtdata As String, placementcell As Range, chttype As Long, chtcat As String)

    Dim cht As Chart
    Dim ax1 As Axis
    'create chart
    Set cht = ActiveSheet.ChartObjects.Add(Left:=placementcell.Left, Width:=placementcell.Width, Top:=placementcell.Top, Height:=placementcell.Height).Chart
    'format the chart
    On Error Resume Next
    With cht
        .ChartType = chttype
        .HasLegend = False
        .SetSourceData Source:=Range(chtdata)
        .ChartArea.Border.LineStyle = xlNone
        .PlotArea.Border.LineStyle = xlNone
        .ChartArea.Fill.Visible = False
        .PlotArea.Fill.Visible = False
        .HasTitle = False
    End With
    'remove gridlines
    For Each ax1 In cht.axes
        ax1.HasMajorGridlines = False
        ax1.HasMinorGridlines = False
    'delete axes
    With cht
        .SeriesCollection(1).XValues = chtcat
    End With
    'format chart on category name
    Call format_charts(cht, Range(chtcat))
End Sub

Sub format_charts(cht As Chart, formatrng As Range)

    Dim rng As Range
    Dim srs As Series
    Dim i As Long
    Set srs = cht.SeriesCollection(1)
    'run loop to format chart
    For i = 1 To srs.Points.Count
        For Each rng In formatrng.Cells
            If UCase(srs.XValues(i)) = UCase(rng.Value) Then
                srs.Points(i).Interior.Color = rng.Offset(1, 0).Interior.Color
                Exit For
            End If

End Sub

Download Working File

Note : 

  • Adjust the size of column first in which you will be adding the charts before you run the macro  
  • The macro will first delete all the charts on the worksheet and then it will create new in-cell charts in column F & G
  • Download Sample file and make changes as per your requirement 


  1. Hi Ashish,

    thanks for your efforts.

    when i change color of cells the color didn't change in chart!!

  2. can you please share the sample file with us here


Import data from SQL

Macro to import data from SQL using ADO connection string: Sub Import_data_from_SQL() ' Tools -> References -> Microsoft Active...