cellMatrix.net

Creating Multiple Static Charts from an Excel Database

Periodically I have to present a report showing trends for each work unit within the practice that I work for. There are approximately 100 work units and the trend for each unit must be presented in chart form. For years we used a single workbook that contained an embedded chart for each unit. Unfortunately, because work units changed and employees changed jobs, this method proved to be time consuming and prone to error.

A more efficient process involves storing the data for each work unit in database form. In this example, a worksheet called "dBase" reflects the data for the work units as follows:

A second sheet, called "Model", contains a single chart and a chart source arranged as follows:

Based on the name of the unit in the "Model" tab - cell "F4", the data in the range "C7:N7" is updated via lookup formulas with the data from the "dBase" tab.

To create the report, a macro loops through the "dBase" tab - range "C5:C19". The unit name is recorded in cell "C5" above. Lookup formulas update the chart source based on the unit name. The updated chart from the "Model" tab is copied as a shape and then placed on a third sheet called "Rpt". The "Rpt" tab is what is presented.

The macro that builds the report is below:

Sub BuildReport()

    Application.ScreenUpdating = False

    Call DeleteShapes

    Dim Cht As Chart
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Rng3 As Range

    Dim Count As Integer
    Dim ChartsAcross As Integer

    Set Rng2 = Sheets("Model").Range("F4")
    Set Rng3 = Sheets("Rpt").Range("C5")
    Set Cht = Sheets("Model").ChartObjects("Cht1").Chart

    ChartsAcross = 2

    For Each Rng1 In Sheets("dBase").Range("C5:C19")

        Rng2 = Rng1

        Cht.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        With Rng3.Parent
            .Paste
            With .Shapes(.Shapes.Count)
                .Left = Rng3.Left
                .Top = Rng3.Top
            End With

            Rng3.Offset(-1, 0).Value = Rng2.Value
            Rng3.Offset(-1, 2).Value = "Chart " & Sheets("Rpt").Shapes.Count
            Rng3.Offset(-1, 2).HorizontalAlignment = xlRight
        
        End With

        If Sheets("Rpt").Shapes.Count Mod ChartsAcross = 0 Then
            Set Rng3 = Rng3.Offset(11, -4)
        Else
            Set Rng3 = Rng3.Offset(0, 4)
        End If

    Next Rng1

End Sub

Note that chart on the "Model" tab has been named "Cht1". You can find more about how to name an Excel chart at the Peltier Technical Services site.

The resulting report looks like this:

Note that the macro runs efficiently because it does not individually select a sheet, chart, or shape.

Letting a macro do the work has cut several hours off of the time it originally took to create the report. Errors are all but nonexistent.