Create an In Cell Chart Using VBA

Automate Excel

Create an In Cell Chart Using VBA

The following tutorial will describe how to create a chart in a cell like the one displayed in the table above under the “Trend” column.

The chart is created using a function called “CellChart”. You would enter it in Excel like any other standard function i.e. SUM, AVERAGE or VLOOKUP etc. This function is called a “User Defined Function” and is not a standard function available within Microsoft Excel. It must be created by the user using VBA.

When entered into Excel, the CellChart function looks like this:

Taking a closer look at the CellChart function, the range for the chart is defined in the first part of the function, C3:F3 in the example above. Next the color of the chart is defined, 203 using the example above.

Now for the VBA stuff

1. Enter the VBA project window by right clicking on a sheet name and selecting “View Code” or by selecting “ALT, F11”.

2. On the right hand side, right click on your project name and select inset “module”.

3. Copy and paste the following code into the new module you just created:

'Creates a new function called Cell Chart
Function CellChart(Plots As Range, Color As Long) As String

'Defines the variables that will be used later on in the code
Const cMargin = 2
Dim rng As Range, arr() As Variant, i As Long, j As Long, k As Long
Dim dblMin As Double, dblMax As Double, shp As Shape

'The following calculates the plots to be used for the chart
Set rng = Application.Caller
    ShapeDelete rng
    For i = 1 To Plots.Count
        If j = 0 Then
            j = i
        ElseIf Plots(, j) > Plots(, i) Then
            j = i
        End If
        If k = 0 Then
            k = i
        ElseIf Plots(, k) < Plots(, i) Then
            k = i
        End If
    Next
    dblMin = Plots(, j)
    dblMax = Plots(, k)

 'The next piece of code determines the shape and position of the chart
     With rng.Worksheet.Shapes
        For i = 0 To Plots.Count - 2
            Set shp = .AddLine( _
                cMargin + rng.Left + (i * (rng.Width - (cMargin * 2)) / (Plots.Count - 1)), _
                cMargin + rng.Top + (dblMax - Plots(, i + 1)) * (rng.Height - (cMargin * 2)) / (dblMax - dblMin), _
                cMargin + rng.Left + ((i + 1) * (rng.Width - (cMargin * 2)) / (Plots.Count - 1)), _
                cMargin + rng.Top + (dblMax - Plots(, i + 2)) * (rng.Height - (cMargin * 2)) / (dblMax - dblMin))

 'Difines what happens if there is an error
            On Error Resume Next
            j = 0: j = UBound(arr) + 1
            On Error GoTo 0
            ReDim Preserve arr(j)
            arr(j) = shp.Name
        Next

        With rng.Worksheet.Shapes.Range(arr)
            .Group

            If Color > 0 Then .Line.ForeColor.RGB = Color Else .Line.ForeColor.SchemeColor = -Color
        End With

    End With

    CellChart = ""
End Function

Sub ShapeDelete(rngSelect As Range)

'Defines the variables that will be used later on in the code
    Dim rng As Range, shp As Shape, blnDelete As Boolean

      For Each shp In rngSelect.Worksheet.Shapes
        blnDelete = False
        Set rng = Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), rngSelect)
        If Not rng Is Nothing Then
            If rng.Address = Range(shp.TopLeftCell, shp.BottomRightCell).Address Then blnDelete = True
        End If

        If blnDelete Then shp.Delete
    Next
End Sub

4. Click on the save button.
5. Click on the little Excel icon on the top right under the “File” menu to exit the VBA project window and to return to Excel

6. Enter the CellChart function into any cell as displayed above.
7. See the attached workbook for a working example of the above.

For further information on this type of in cell charting, please visit:

http://www.dailydoseofexcel.com/archives/2006/02/05/in-cell-charting/

Related posts

3 Responses

  1. Jakob Says:

    Hello,
    Very nice function, but returns an error, if all the values are equal. Do you have any solution to that?

    Kkv. Jakob

  2. Jakob Says:

    Hello again,
    It only seems to work if the values are in a row, but not in a column.
    Kkv. Jakob

  3. Robert R Says:

    This function ROCKS! Works like a charm if ya know what you are doing…

Leave a Comment

Please note: Comment moderation is enabled and may delay your comment. There is no need to resubmit your comment.