I discovered a while ago that you can create a Shape from a user-defined function.

This opens the possibility for having custom made graphics dependent on other cells. Meaning, when the data changes, your graphic changes too.

Some possible graphics include line charts, gantt charts, Excel12 style traffic lights.

As an example, I’ve put together a very basic Sparkline (in-cell line chart) graphic. If you want to know more about Sparklines, start at ewbi.develops

I have a userdefined function named LineChart. It will take a row of values and use them to create a simple linechart within the cell containing the formula.

The formula in cell K1 is =LineChart(A1:J1, 203)

A1:J1 are the data values

203 repesents the colour value for RGB(203, 0, 0)

Finally, the code behind the user-defined function:

`Function LineChart(Points As Range, Color As Long) As String`

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

```
``` Set rng = Application.Caller

ShapeDelete rng

For i = 1 To Points.Count

If j = 0 Then

j = i

ElseIf Points(, j) > Points(, i) Then

j = i

End If

If k = 0 Then

k = i

ElseIf Points(, k) < Points(, i) Then
k = i
End If
Next
dblMin = Points(, j)
dblMax = Points(, k)
With rng.Worksheet.Shapes
For i = 0 To Points.Count - 2
Set shp = .AddLine( _
cMargin + rng.Left + (i * (rng.Width - (cMargin * 2)) / (Points.Count - 1)), _
cMargin + rng.Top + (dblMax - Points(, i + 1)) * (rng.Height - (cMargin * 2)) / (dblMax - dblMin), _
cMargin + rng.Left + ((i + 1) * (rng.Width - (cMargin * 2)) / (Points.Count - 1)), _
cMargin + rng.Top + (dblMax - Points(, i + 2)) * (rng.Height - (cMargin * 2)) / (dblMax - dblMin))
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

LineChart = ""

End Function

Sub ShapeDelete(rngSelect As Range)

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

ShapeDelete is an alteration of the ShapeDelete code available on my website

Note that Application.Caller is used to determine which cell is running the formula. That is also used for determining the boundaries of the cell.

One “gotcha” about UDF charts is that you cannot create any shape that writes Text. That can make drawing Legend tables or Value indicators difficult. That said, it’s great for drawing graphics.