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
and it’s copied down. Here’s the revised code:
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
If Application.Intersect(Points, VerticalScale).Address = _
Points.Address 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
Set shp = .AddLine( _
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
If rng.Address = Range(shp.TopLeftCell, shp.BottomRightCell).Address Then blnDelete = True
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?
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.
Here’s how you name the shape:
.Group
.Line.ForeColor.RGB = Abs(Color)
End With
rCaller.Worksheet.Shapes(rCaller.Worksheet.Shapes.Count).Name = _
“InCell_” & rCaller.Address(False, False) & “_Line”
End With
LineChart = “”
End Function
and here’s how you delete the shape:
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
If rng.Address = rngSelect.Worksheet.Range(sCell).Address Then blnDelete = True
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.
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.
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.
That looks better. See here for how to put code in your comments.
And I only crashed Excel once. :)
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.
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?
…I read the bost about the VB tags…
Typo. I think I meant “post”, not “boast”, but either way…
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.
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?
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.
Stephen –
Thanks for the explanation. Where can I read about how to implement this? And do you think it would help with stability?
Jon – http://www.oaltd.co.uk/DLCount/DLCount.asp?file=UpdatCht.zip is an example of the technique that applies calculated axis scales to charts.
Jon:
Yes, I see now – Kewl!
It sure doesn’t like ratio arrays (decimal values less than 1).
Hi Jon,
I found error for the statement below, is the second line wrongly displayed?
Thanks
“InCell_” & rCaller.Address(False, False) & “_Line”
Emily-
It is. Replace & with a single &
That was to be expected. It does not display as I intended
Emily, just delete twice this part:
amp;
and it should work
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.
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
‘ If rng.Address = Range(shp.TopLeftCell, shp.BottomRightCell).Address Then blnDelete = True
‘ 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
If rng.Address = rngSelect.Worksheet.Range(sCell).Address Then blnDelete = True
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) > 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
If Application.Intersect(Points, VerticalScale).Address = _
Points.Address 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
Set shp = .AddLine( _
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_” & rCaller.Address(False, False) & “_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:
DrawLineChart
End Sub
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
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.
(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.
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
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
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
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.
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))
StrtBad = Margin + rng.Left + (WidthCell * (Bad / Maxi))
EndBad = rng.Left + WidthCell – (Margin) – StrtBad
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 ShpBad = .AddShape(msoShapeRectangle, StrtBad, TopBkgrd, EndBad, HBckgrnd)
ShpBad.Line.Visible = msoFalse
ShpBad.Fill.ForeColor.RGB = 13158600
arr(2) = ShpBad.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
If rng.Address = Range(shp.TopLeftCell, shp.BottomRightCell).Address Then blnDelete = True
End If
If blnDelete Then shp.Delete
Next
End Sub
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))
StrtBad = Margin + rng.Left + (WidthCell * (Bad / Maxi))
EndBad = rng.Left + WidthCell – (Margin) – StrtBad
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 ShpBad = .AddShape(msoShapeRectangle, StrtBad, TopBkgrd, EndBad, HBckgrnd)
ShpBad.Line.Visible = msoFalse
ShpBad.Fill.ForeColor.RGB = 13158600
arr(2) = ShpBad.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
If rng.Address = Range(shp.TopLeftCell, shp.BottomRightCell).Address Then blnDelete = True
End If
If blnDelete Then shp.Delete
Next
End Sub
I think it would make sense to replace:
Set rScale = Points
Else
If Not Application.Intersect(Points, VerticalScale) Is Nothing Then
If Application.Intersect(Points, VerticalScale).Address = _
Points.Address 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:
Oops. I meant, replace it with:
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.
Come to think of it, in the first post, the whole complex ShapeDelete procedure can be replaced with:
Dim shp As Shape
For Each shp In rngSelect.Worksheet.Shapes
If rngSelect.Address = Range(shp.TopLeftCell, shp.BottomRightCell).Address Then shp.Delete
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.
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.
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:
http://www.prodomosua.eu/ppage02.html
(also posted in this thread: http://www.dailydoseofexcel.com/archives/2006/02/05/in-cell-charting/)