Welcome to Blogs @ Andrew Qu
Blog Index
All blogs
Search results

Excel VBA Dynamic Charting

Summary

I this blog, I try to draw some Excel charts dynamically using VBA macros

Preparation work

Before you start, you need to prepare you excel work book so that it can run macros, enabled developer view (VBA) etc.

  1. Create a new workbook, named chart_demo
  2. Enable developer view: Right click menu area -> [Customize Ribon] -> [Main Tabs] -> [Developer]
  3. Enable macro: [Developer] -> [Macro security] -> [Macro Settings] -> [Enable all macros(not...)]
  4. Such files will be saved as "*.xlsm" where m is for macro.
  5. Enter some data so that the table may look like below:
  6. Developer -> Visual basic
  7. In visual basic window, double click sheet1
  8. In the empty code window, add the following code
Dim NextChartXpos As Integer
Dim LastChartYpos As Integer

Private Function MyNewChart(ItemFrom As String, ItemTo As String, _
    Optional ByVal Yoffset As Integer = 0, Optional ByVal SideBySide As Integer = 0)
    Dim myChtObj As ChartObject
    Dim fromCell As Range
    Dim toCell As Range
    Dim iColumn As Integer
    Dim iRow As Integer
    Dim numSeries As Integer
    Dim chartLeft As Integer
    Dim chartTop As Integer
    Dim chartWidth As Integer
    Dim YValues() As Double
    Dim XValues() As String
    
    Set fromCell = ActiveSheet.Range("A2:A100").Find(What:=ItemFrom, LookIn:=xlValues)
    Set toCell = ActiveSheet.Range("A2:A100").Find(What:=ItemTo, LookIn:=xlValues)
    ' MsgBox " vs= " & fromCell.Value & " ve= " & toCell.Value
    chartLeft = fromCell.Offset(0, 7).Left + 10
    numSeries = toCell.Row - fromCell.Row + 1
    chartWidth = 100 * numSeries + 150
    ReDim XValues(numSeries - 1)
    ReDim YValues(numSeries - 1)
    
    chartTop = fromCell.Top + Yoffset
    If SideBySide = 1 Then
        chartLeft = NextChartXpos
        chartTop = LastChartYpos
    End If
    
    Set myChtObj = ActiveSheet.ChartObjects.Add _
        (Left:=chartLeft, Width:=chartWidth, Top:=chartTop, Height:=125)
    myChtObj.Name = "DCT_" & ItemFrom
    NextChartXpos = chartLeft + chartWidth + 15
    LastChartYpos = chartTop
    
    For iRow = 1 To numSeries
        XValues(iRow - 1) = fromCell.Offset(iRow - 1, 0).Value
    Next
        
    With myChtObj.Chart
        .ChartType = XlChartType.xlColumnClustered
        For iColumn = 1 To 5
            For iRow = 1 To numSeries
                YValues(iRow - 1) = fromCell.Offset(iRow - 1, iColumn).Value
            Next
            With .SeriesCollection.NewSeries
                .Name = ActiveSheet.Range("A1").Offset(0, iColumn).Value
                .XValues = XValues
                .Values = YValues
            End With
        Next
    End With
End Function

Private Sub Worksheet_Activate()
    Dim ii As Integer
        
    ' Delete all charts
    For Each myChtObj In ActiveSheet.ChartObjects
       If Left(myChtObj.Name, 4) = "DCT_" Then
           myChtObj.Delete
       End If
    Next
    
    ' Create new charts
    ii = MyNewChart(ItemFrom:="2001", ItemTo:="2004")
    ii = MyNewChart(ItemFrom:="2005", ItemTo:="2005")
    ii = MyNewChart(ItemFrom:="2006", ItemTo:="2006", SideBySide:=1)
End Sub
Now, swtich to Sheet2 and back to Sheet1, 3 charts should be created:


Code Analysis

Now let's explain some of the code.

Dim NextChartXpos As Integer
Dim LastChartYpos As Integer
NextChartXpos - Remembers the xpos of the next side by side chart, such as chart 2005 and 2006 LastChartYpos - Remembers the ypos of the next side by side chart, so that they are aligned
Private Function MyNewChart(ItemFrom As String, ItemTo As String, _
    Optional ByVal Yoffset As Integer = 0, Optional ByVal SideBySide As Integer = 0)
ItemFrom - Cell value in colum A to start chart row
ItemTo - Cell value in column A to end char row
Yoffset - Top of the chart will be aligned with cell ItemFrom. Specify this value to
              move chart up(+)/down(-) from the default position.
SideBySide - If this chart is to be placed on the right side of the last chart. 1-Yes, 0-No
    Set fromCell = ActiveSheet.Range("A2:A100").Find(What:=ItemFrom, LookIn:=xlValues)
    Set toCell = ActiveSheet.Range("A2:A100").Find(What:=ItemTo, LookIn:=xlValues)
    ' MsgBox " vs= " & fromCell.Value & " ve= " & toCell.Value
    chartLeft = fromCell.Offset(0, 7).Left + 10
    numSeries = toCell.Row - fromCell.Row + 1
    chartWidth = 100 * numSeries + 150
    ReDim XValues(numSeries - 1)
    ReDim YValues(numSeries - 1)
    
    chartTop = fromCell.Top + Yoffset
    If SideBySide = 1 Then
        chartLeft = NextChartXpos
        chartTop = LastChartYpos
    End If
    
    Set myChtObj = ActiveSheet.ChartObjects.Add _
        (Left:=chartLeft, Width:=chartWidth, Top:=chartTop, Height:=125)
    myChtObj.Name = "DCT_" & ItemFrom
    NextChartXpos = chartLeft + chartWidth + 15
    LastChartYpos = chartTop
First, we find the start and end cells, by using searching in column A from row 2 to 100. ActiveSheet is the sheet in which the macro runs. Range("A2:A100") is a selection of cells in column A from row 2 to row 100.

Ads from Google
Dr Li Anchor Profi
www.anchorprofi.de
Engineering anchorage plate design system
©Andrew Qu, 2015. All rights reserved. Code snippets may be used "AS IS" without any kind of warranty. DIY tips may be followed at your own risk.