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
            cht.Delete
        End If
    Next
    
    ' 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)
    Next
    

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
    Next
    'delete axes
    With cht
        .axes(xlCategory).Delete
        .axes(xlValue).Delete
        .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
        Next
    Next

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 


2 comments:

  1. Hi Ashish,

    thanks for your efforts.

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

    ReplyDelete
  2. can you please share the sample file with us here
    http://www.facebook.com/groups/excelvbamacros/
    http://www.facebook.com/EXCELVBAMACROS

    ReplyDelete

Import data from SQL

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