# Scaled In Cell Charting

I was using In Cell Charting, but it didn’t quite look right. I needed each chart to be scaled over a range that encompasses all the values. In the following screen, cell G4 seems to fluctuate wildly. But if these were all expense classifications, it overstates the importance of those fluctuations. Why did expenses rise or fall over those five periods? Column F tells you that only line 3 and line 6 would have a demonstrable impact on expenses as a whole. Cell F3 has this formula

=linechart(A3:E3,203,\$A\$3:\$E\$8)

and it’s copied down. Here’s the revised code:

Function LineChart(Points As Range, Color As Long, Optional VerticalScale As Range) As String

Dim rCaller As Range
Dim avNames() As Variant
Dim i As Long, j As Long, k As Long
Dim dMin As Double, dMax As Double, dScaleMin As Double, dScaleMax As Double
Dim shp As Shape
Dim rScale As Range
Dim dEffWidth As Double, dEffHeight As Double, dEffBottom As Double, dEffLeft As Double

Const lMARGIN As Long = 2

Set rCaller = Application.Caller

ShapeDelete rCaller

‘If VerticalScale Is Nothing Then
‘    Set rScale = Points
‘Else
‘    Set rScale = VerticalScale
‘End If

If VerticalScale Is Nothing Then
Set rScale = Points
Else
If Not Application.Intersect(Points, VerticalScale) Is Nothing Then

Set rScale = VerticalScale
Else
Set rScale = Application.Union(Points, VerticalScale)
End If
Else
Set rScale = Application.Union(Points, VerticalScale)
End If
End If

With Application.WorksheetFunction
dMin = .Min(Points)
dMax = .Max(Points)
dScaleMin = .Min(rScale)
dScaleMax = .Max(rScale)
End With

dEffWidth = rCaller.Width – (lMARGIN * 2)
dEffHeight = rCaller.Height – (lMARGIN * 2)
dEffBottom = rCaller.Top + lMARGIN + dEffHeight
dEffLeft = rCaller.Left + lMARGIN

With rCaller.Worksheet.Shapes
For i = 0 To Points.Count – 2

dEffLeft + (i * (dEffWidth) / (Points.Count – 1)), _
dEffBottom – (dEffHeight * (Points(, i + 1) – dScaleMin + 1) / (dScaleMax – dScaleMin + 1)), _
dEffLeft + ((i + 1) * (dEffWidth) / (Points.Count – 1)), _
dEffBottom – (dEffHeight * (Points(, i + 2) – dScaleMin + 1) / (dScaleMax – dScaleMin + 1)))

On Error Resume Next
j = 0
j = UBound(avNames) + 1
On Error GoTo 0

ReDim Preserve avNames(j)
avNames(j) = shp.Name
Next

With rCaller.Worksheet.Shapes.Range(avNames)
.Group
.Line.ForeColor.RGB = Abs(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
End If

If blnDelete Then shp.Delete
Next
End Sub

You can omit the last argument and it should work as it did before. I think there may be some problems if you define a VerticalScale that has no bearing on the data. I should probably check that Points is contained in VerticalScale. The potential problem is that if the Shape object is drawn outside of the cell, it won’t get deleted properly on recalc.

Update: I was right, it was a disaster. I changed the code, but left the original IF block in there, just commented out. I don’t know if that fix is really desirable though. Your thoughts?

Posted in Uncategorized

## 35 thoughts on “Scaled In Cell Charting”

1. Jon Peltier says:

If the location of the shape cannot be counted on for identification of shapes to delete, you could do something creative with the shape name. Give the shape a descriptive name, something that includes the address, like “InCell_A1_Line”. Then your code can look for the range in the shape name (between underscore characters), compare this range to the range called out in the LineChart formula.

2. Jon Peltier says:

Here’s how you name the shape:

With rCaller.Worksheet.Shapes.Range(avNames)
.Group
.Line.ForeColor.RGB = Abs(Color)
End With

rCaller.Worksheet.Shapes(rCaller.Worksheet.Shapes.Count).Name = _
“InCell_” &amp; rCaller.Address(False, False) &amp; “_Line”

End With

LineChart = “”

End Function

and here’s how you delete the shape:

Sub ShapeDelete(rngSelect As Range)
Dim rng As Range, shp As Shape, blnDelete As Boolean
Dim sShp As String, sCell As String

For Each shp In rngSelect.Worksheet.Shapes
blnDelete = False
sShp = shp.Name
sCell = Mid\$(sShp, InStr(sShp, “_”) + 1)
sCell = Left\$(sCell, InStr(sCell, “_”) – 1)
Set rng = Intersect(rngSelect, rngSelect.Worksheet.Range(sCell))
If Not rng Is Nothing Then
End If

If blnDelete Then shp.Delete
Next

End Sub

I don’t remember if the pre tabs work here.

Editor: I put the vb-in-brackets around your code.

3. Jon Peltier says:

Now I remember, the pre tags don’t work here. At least I had no greeater thans and less thans to mess it up.

By the way, I meant to call this a neat trick, but then I crashed Excel five times in like 15 minutes. Kind of reminds me of Excel 5 on Windows 3.1.

4. Rob van Gelder says:

I too have found shapes-from-udf (in cell charting) crashes Excel…
In the past, I resorted to a button for drawing the graphics.

I recall a suggestion that the UDFs register their cell as dirty, so that at timed intervals, the dirty cells are redrawn.

5. Dick Kusleika says:

That looks better. See here for how to put code in your comments.

And I only crashed Excel once. :)

6. wally says:

Comment Deleted. It was an Excel question that had nothing to do with this post and was posted to at least one other Excel blog today.

7. Jon Peltier says:

Dick –

Thanks for cleaning up after my code. I know I read the bost about the VB tags, but ss I have to reboot my flash memory. If that PLAIN TEXT thing looked more like a link, I might have clicked on one.

Rob –

I tried to find the post about the UDF marking the cell (I vaguely remember something like that, but there’s the memory issue again). Do you know how that works?

8. Jon Peltier says:

Typo. I think I meant “post”, not “boast”, but either way…

9. Stephen Bullen says:

Jon,

Re UDF marking the cell. The UDF takes the parameters, adds the Caller and some sort of task ID, puts it all in UDT/array and adds it to a global collection/array – effectively creating a task list. The _Calculate event goes through the global collection and processes the tasks. The difference between the two approaches is that the ‘pure’ UDF does its stuff when you F2+Enter, while the mark/calc method only does its stuff on a sheet/book recalc.

10. doco says:

Dick: Trying to think of a practical application for what I do. But I am not understanding the importance of having a relative reference in the first term then an absolute reference to the entire array row upon row in the last term. What is this telling me about the data?

11. Jon Peltier says:

Doco –

The first range is what provides the data for that row’s chart. The overall range is what the code searches for the min and max for all of the charts, so they all use the same scale.

12. Jon Peltier says:

Stephen –

Thanks for the explanation. Where can I read about how to implement this? And do you think it would help with stability?

13. doco says:

Jon:

Yes, I see now – Kewl!

14. doco says:

It sure doesn’t like ratio arrays (decimal values less than 1).

15. Emily says:

Hi Jon,

I found error for the statement below, is the second line wrongly displayed?

Thanks

rCaller.Worksheet.Shapes(rCaller.Worksheet.Shapes.Count).Name = _
“InCell_” &amp; rCaller.Address(False, False) &amp; “_Line”
16. Gerrit Kiers says:

Emily-

It is. Replace & with a single &

17. Gerrit Kiers says:

That was to be expected. It does not display as I intended
Emily, just delete twice this part:
amp;
and it should work

18. Jon Peltier says:

Well, I spent 3 seconds following up on doco’s comment about decimal fractions. The charts seemed to update fine, and I was copying the data range and pasting the values (I’d used a formula with RAND() to get fractional values) when Excel crashed.

My conclusion: using a UDF is not nearly stable enough. You can just as easily run the code off of a worksheet_change event. Keep the formula in the cell, but take out the drawing routine and leave only the LineChart = “” piece. Then in the event procedure, parse the formula, and run the regular code.

When I get a minute I’ll do a proof of concept.

19. Jon Peltier says:

This incorporates two enhancements.

1. It runs off the Worksheet_Calculate event

This has proven to be way more stable.

2. It works better for small fractions

The other code had a +1 in the formulas that determined the Y coordinates of the endpoints of each line. Adding 1 helped when the values are large, but when they are small, 1 was greater than the Y axis range. I changed this 1 to dScaleMargin, which was a small fraction of the Y axis range.

Code in regular module:

‘——————————-
Function LineChart(Points As Range, Color As Long, Optional VerticalScale As Range) As String

LineChart = “”

End Function
‘——————————-
Sub ShapeDelete(rngSelect As Range)
Dim rng As Range, shp As Shape, blnDelete As Boolean
Dim sShp As String, sCell As String

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

‘        If blnDelete Then shp.Delete
‘    Next

For Each shp In rngSelect.Worksheet.Shapes
blnDelete = False
sShp = shp.Name
sCell = Mid\$(sShp, InStr(sShp, “_”) + 1)
sCell = Left\$(sCell, InStr(sCell, “_”) – 1)
Set rng = Intersect(rngSelect, rngSelect.Worksheet.Range(sCell))
If Not rng Is Nothing Then
End If

If blnDelete Then shp.Delete
Next

End Sub
‘——————————-
Sub DrawLineChart()
Dim rFormulas As Range
Dim rArea As Range
Dim sFormula As String
Dim aFormula As Variant
Dim Points As Range
Dim Color As Long
Dim VerticalScale As Range
Dim rCaller As Range
Dim avNames() As Variant
Dim i As Long, j As Long, k As Long
Dim dMin As Double, dMax As Double, dScaleMin As Double, dScaleMax As Double
Dim shp As Shape
Dim rScale As Range
Dim dEffWidth As Double, dEffHeight As Double, dEffBottom As Double, dEffLeft As Double
Dim dScaleMargin As Double

Const lMARGIN As Long = 2

Application.EnableEvents = False

Set rFormulas = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)

For Each rArea In rFormulas.Areas

For Each rCaller In rArea.Cells

sFormula = UCase\$(rCaller.Formula)

If Left\$(sFormula, 11) = “=LINECHART(“ Then

sFormula = Mid\$(sFormula, 12)
sFormula = Left\$(sFormula, Len(sFormula) – 1)
aFormula = Split(sFormula, “,”)

Set Points = ActiveSheet.Range(aFormula(0))
Color = CLng(aFormula(1))
If UBound(aFormula) &gt; 1 Then
Set VerticalScale = ActiveSheet.Range(aFormula(2))
End If

ShapeDelete rCaller

If VerticalScale Is Nothing Then
Set rScale = Points
Else
If Not Application.Intersect(Points, VerticalScale) Is Nothing Then

Set rScale = VerticalScale
Else
Set rScale = Application.Union(Points, VerticalScale)
End If
Else
Set rScale = Application.Union(Points, VerticalScale)
End If
End If

With Application.WorksheetFunction
dMin = .Min(Points)
dMax = .Max(Points)
dScaleMin = .Min(rScale)
dScaleMax = .Max(rScale)
End With
dScaleMargin = (dScaleMax – dScaleMin) / 50

dEffWidth = rCaller.Width – (lMARGIN * 2)
dEffHeight = rCaller.Height – (lMARGIN * 2)
dEffBottom = rCaller.Top + lMARGIN + dEffHeight
dEffLeft = rCaller.Left + lMARGIN

With rCaller.Worksheet.Shapes
For i = 0 To Points.Count – 2

dEffLeft + (i * (dEffWidth) / (Points.Count – 1)), _
dEffBottom – (dEffHeight * (Points(, i + 1) – dScaleMin + dScaleMargin) / _
(dScaleMax – dScaleMin + 2 * dScaleMargin)), _
dEffLeft + ((i + 1) * (dEffWidth) / (Points.Count – 1)), _
dEffBottom – (dEffHeight * (Points(, i + 2) – dScaleMin + dScaleMargin) / _
(dScaleMax – dScaleMin + 2 * dScaleMargin)))

On Error Resume Next
j = 0
j = UBound(avNames) + 1
On Error GoTo 0

ReDim Preserve avNames(j)
avNames(j) = shp.Name
Next

With rCaller.Worksheet.Shapes.Range(avNames)
.Group
.Line.ForeColor.RGB = Abs(Color)
End With

” if this line contains funny stuff replace with plain ampersands
rCaller.Worksheet.Shapes(rCaller.Worksheet.Shapes.Count).Name = _
“InCell_” &amp; rCaller.Address(False, False) &amp; “_Line”

Erase avNames
Set rCaller = Nothing
Set Points = Nothing
Set rScale = Nothing
Set VerticalScale = Nothing
End With
End If
Next
Next

Application.EnableEvents = True

End Sub
‘——————————-

Code in worksheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
DrawLineChart
End Sub
20. Kevin Fitting says:

Quick question… when you actually create your line object (line of code beginning with Set Shp =) why do you use “points(,i+1)”? This forces you to use horizontal tables of data. If you just delete the comma, the function works on vertical tables as well (at least it did in the few cases I tried).

Kevin

21. Jon Peltier says:

Kevin –

That’s the flexibiity of it. Generally these sparklines are envisioned as describing the rows of a table, so the data for each line is arranged by rows. However, if you had a different requirement, you could change the code to use data in columns.

22. Jon Peltier says:

(slaps forehead) But why not build flexibility into the code?

First point, since I can’t usually remember what’s the default property of an object, I’ve gotten into the practice of always stating all of my properties. So

Points(, i + 1)

should really be

Points(, i + 1).Value

However, to allow for horizontally or vertically oriented data, you could use

Points.Cells(i + 1).Value

Upstream of this, of course, you need to make sure that the range Points is a on dimensional range.

23. Kevin Fitting says:

Ok, points.cells makes more sense. Another question, is there any way to get the line to go across merged cells? Where is the width pulled from?

Kevin

24. Kevin Fitting says:

Got it. Change the lines for width and height to this:
dEffWidth = rCaller.MergeArea.Width – (lMARGIN * 2)
dEffHeight = rCaller.MergeArea.Height – (lMARGIN * 2)

Now it will put the line across a merged cell. Next, I’m going to try to get it to draw a vertical line for vertical data. Shouldn’t be too hard… (famous last words!)

Kevin

25. Kevin Fitting says:

Don’t know if this will help the excel crashing, but before you delete a shape, move it to with in the cell border. I’ve been working on putting labels at specific points along the line. If those labels protrude into adjacent cells, excel crashes when it tries to delete them (not while stepping through though… annoying!). Solution was to move each label to the left top edge of the cell, then delete. I’ll probably shrink it’s width to handle small cells, but it seems to work. I wonder if this were applied to the line itself Excel wouldn’t crash. I don’t know.

Kevin

26. Jon Peltier says:

Hmmm, didn’t try that. Not moving the shapes, I doubt that’s the issue. I think Excel just needs the short break that moving the shapes provides. I’ll try using DoEvents, probably after each shape is made and after each is deleted.

27. Fabrice Rimlinger says:

Bonjour,

here is a modest contribution to this post that helped me so much.
another tool on the “in cell” chartind UDF subject, the bullet chart as explained here : http://www.exceluser.com/explore/bullet.htm

Thaks to a

Function BulletChart(Mesure As Double, Target As Double, Maxi As Double, Optional Good As Double, Optional Bad As Double) As String
Const Margin = 2
Const Thick = 1.5
Dim rng As Range
Dim arr() As Variant
Dim sng As Single, RapTM As Single
Dim HBckgrnd As Single, HMesure As Single, HTarget As Single
Dim TopBkgrd As Single, TopMesure As Single, TopTarget As Single
Dim StrtMesure As Single, StrtTarget As Single, StrtGood As Single, StrtAverage As Single, StrtBad As Single
Dim EndBckgrd As Single, EndMesure As Single, EndTarget As Single, EndBad As Single, EndGood As Single, EndAverage As Single
Dim ShpBad As Shape, ShpGood As Shape, ShpAverage As Shape, ShpTarget As Shape, ShpMesure As Shape
Dim WidthCell As Single

Set rng = Application.Caller
ShapeDelete rng

With rng.Worksheet.Shapes
WidthCell = rng.MergeArea.Width
HBckgrnd = (rng.Height – (Margin * 2))
HMesure = (rng.Height * 0.5 – Margin * 2)
HTarget = (rng.Height * 0.9 – Margin * 2)
TopBkgrd = rng.Top + Margin
TopMesure = rng.Top + Margin + rng.Height * 0.25
TopTarget = rng.Top + Margin + rng.Height * 0.05
StrtMesure = Margin + rng.Left
StrtTarget = Margin + rng.Left + (WidthCell * (Target / Maxi))
StrtGood = StrtMesure
StrtAverage = Margin + rng.Left + (WidthCell * (Good / Maxi))
EndGood = rng.Left + WidthCell – (Margin) – StrtGood
EndAverage = rng.Left + WidthCell – (Margin) – StrtAverage
EndMesure = Margin + rng.Left + (WidthCell * (Mesure / Maxi)) – StrtMesure
EndTarget = Margin + rng.Left + (WidthCell * (Target / Maxi)) + Thick – StrtTarget

ReDim arr(1 To 5)

Set ShpGood = .AddShape(msoShapeRectangle, StrtGood, TopBkgrd, EndGood, HBckgrnd)
ShpGood.Line.Visible = msoFalse
ShpGood.Fill.ForeColor.RGB = 11513775
arr(1) = ShpGood.Name

Set ShpAverage = .AddShape(msoShapeRectangle, StrtAverage, TopBkgrd, EndAverage, HBckgrnd)
ShpAverage.Line.Visible = msoFalse
ShpAverage.Fill.ForeColor.RGB = 15132390
arr(3) = ShpAverage.Name

Set ShpMesure = .AddShape(msoShapeRectangle, StrtMesure, TopMesure, EndMesure, HMesure)
ShpMesure.Line.Visible = msoFalse
ShpMesure.Fill.ForeColor.RGB = 0
arr(4) = ShpMesure.Name

Set ShpTarget = .AddShape(msoShapeRectangle, StrtTarget, TopTarget, EndTarget, HTarget)
ShpTarget.Line.Visible = msoFalse
ShpTarget.Fill.ForeColor.RGB = 203
arr(5) = ShpTarget.Name

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

End With

BulletChart = “”
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
End If

If blnDelete Then shp.Delete
Next
End Sub

28. Fabrice Rimlinger says:

Bonjour,

here is a modest contribution to this post that helped me so much.
another tool on the “in cell” chartind UDF subject, the bullet chart as explained here : http://www.exceluser.com/explore/bullet.htm

Thanks to all contributors…

Function BulletChart(Mesure As Double, Target As Double, Maxi As Double, Optional Good As Double, Optional Bad As Double) As String
Const Margin = 2
Const Thick = 1.5
Dim rng As Range
Dim arr() As Variant
Dim sng As Single, RapTM As Single
Dim HBckgrnd As Single, HMesure As Single, HTarget As Single
Dim TopBkgrd As Single, TopMesure As Single, TopTarget As Single
Dim StrtMesure As Single, StrtTarget As Single, StrtGood As Single, StrtAverage As Single, StrtBad As Single
Dim EndBckgrd As Single, EndMesure As Single, EndTarget As Single, EndBad As Single, EndGood As Single, EndAverage As Single
Dim ShpBad As Shape, ShpGood As Shape, ShpAverage As Shape, ShpTarget As Shape, ShpMesure As Shape
Dim WidthCell As Single

Set rng = Application.Caller
ShapeDelete rng

With rng.Worksheet.Shapes
WidthCell = rng.MergeArea.Width
HBckgrnd = (rng.Height – (Margin * 2))
HMesure = (rng.Height * 0.5 – Margin * 2)
HTarget = (rng.Height * 0.9 – Margin * 2)
TopBkgrd = rng.Top + Margin
TopMesure = rng.Top + Margin + rng.Height * 0.25
TopTarget = rng.Top + Margin + rng.Height * 0.05
StrtMesure = Margin + rng.Left
StrtTarget = Margin + rng.Left + (WidthCell * (Target / Maxi))
StrtGood = StrtMesure
StrtAverage = Margin + rng.Left + (WidthCell * (Good / Maxi))
EndGood = rng.Left + WidthCell – (Margin) – StrtGood
EndAverage = rng.Left + WidthCell – (Margin) – StrtAverage
EndMesure = Margin + rng.Left + (WidthCell * (Mesure / Maxi)) – StrtMesure
EndTarget = Margin + rng.Left + (WidthCell * (Target / Maxi)) + Thick – StrtTarget

ReDim arr(1 To 5)

Set ShpGood = .AddShape(msoShapeRectangle, StrtGood, TopBkgrd, EndGood, HBckgrnd)
ShpGood.Line.Visible = msoFalse
ShpGood.Fill.ForeColor.RGB = 11513775
arr(1) = ShpGood.Name

Set ShpAverage = .AddShape(msoShapeRectangle, StrtAverage, TopBkgrd, EndAverage, HBckgrnd)
ShpAverage.Line.Visible = msoFalse
ShpAverage.Fill.ForeColor.RGB = 15132390
arr(3) = ShpAverage.Name

Set ShpMesure = .AddShape(msoShapeRectangle, StrtMesure, TopMesure, EndMesure, HMesure)
ShpMesure.Line.Visible = msoFalse
ShpMesure.Fill.ForeColor.RGB = 0
arr(4) = ShpMesure.Name

Set ShpTarget = .AddShape(msoShapeRectangle, StrtTarget, TopTarget, EndTarget, HTarget)
ShpTarget.Line.Visible = msoFalse
ShpTarget.Fill.ForeColor.RGB = 203
arr(5) = ShpTarget.Name

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

End With

BulletChart = “”
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
End If

If blnDelete Then shp.Delete
Next
End Sub

29. Mr Israel Steinmetz says:

I think it would make sense to replace:

If VerticalScale Is Nothing Then
Set rScale = Points
Else
If Not Application.Intersect(Points, VerticalScale) Is Nothing Then

Set rScale = VerticalScale
Else
Set rScale = Application.Union(Points, VerticalScale)
End If
Else
Set rScale = Application.Union(Points, VerticalScale)
End If
End If

with:

Set rScale = Application.Union(Points, VerticalScale)
30. Mr Israel Steinmetz says:

Oops. I meant, replace it with:

If VerticalScale Is Nothing Then
Set rScale = Points
Else
Set rScale = Application.Union(Points, VerticalScale)
End If

All of the other conditions are meaningless, they come out to the same thing as a simple Union.

31. Mr Israel Steinmetz says:

Come to think of it, in the first post, the whole complex ShapeDelete procedure can be replaced with:

Sub ShapeDelete(rngSelect As Range)
Dim shp As Shape

For Each shp In rngSelect.Worksheet.Shapes
Next
End Sub

The original (complex) procedure first looks for all shapes intersecting rngSelect, then verifies that they are completely contained in rngSelect, then sets a boolean flag, and finally deletes the shape if flagged. Instead, just delete any shape that is contained in rngSelect. Much simpler, and does the same thing.

32. Jon Peltier says:

You don’t want to oversimplify this deletion routine. What if the user accidentally dragged a shape off of its original location? What if a different but important shape happens to be located in the range being cleared? These are why labeling is important. In fact, in one of my iterations (which I may not have posted), the shape name includes the name of the cell it is supposed to cover. The code checkes this name, not the actual top left cell, prior to deletion.

33. Jon Peltier says:

Here’s an outstanding rendition of sparklines by Excel MVP Fernando Cinquegrani:

http://www.prodomosua.eu/zips/sparklines.xls

He draws a normal-sized and normal-featured Excel chart in a far away region of the sheet, copies the underlying range, and uses Paste Link Picture to put a dynamic shrunken image of the chart over the desired cell.

It will fail in 2007 because doing a print preview of a paste linked region that shows a chart hoses the chart. But in versions up to 2003, it is an excellent native sparklines tool. The rest of us can stop now.

Fernando has come up with dozens of innovative display implementations for Excel:

(also posted in this thread: http://www.dailydoseofexcel.com/archives/2006/02/05/in-cell-charting/)

Posting code? Use <pre> tags for VBA and <code> tags for inline.