I responded to Mihai's Compare shapes for obtaining a value post
concerning how to get a value into a cell based on the Shape in that
cell.

Mihai discovered that my suggested code (see code below) resulted in
Error 1004 if AutoFilter was turned on, otherwise it worked perfectly.
The offending code lines are "If Not Intersect(Shp.TopLeftCell,
rngShpVal) Is Nothing Then" and "Shp.TopLeftCell.Value = M", the
only lines referring to "Shp.TopLeftCell" which is causing the
error.

I have used "On Error Resume Next" just before the "For Each
Shp" loop to bypass the error message.

There are two things I don't understand:

1. Why would simply having AutoFilter just turned on, and not actually
doing any filtering (ie Show All) cause the error, and

2. Why is bypassing the error message enough to have my code work
properly, I would have expected the error to cause my code to fail.

I'm glad the code is working but I'd really like to know the inside
story behind the problem.
Any ideas?

Public Sub ShapeCellValue()
Dim Shp As Shape
Dim rngShpVal As Range
Dim J As Byte
Dim M As Byte
'Change Range("C3:F11") to suit your needs
'Grouped shapes outside this range are ignored
Set rngShpVal = _
ActiveSheet.Range("C3:F11")
rngShpVal.ClearContents
On Error Resume Next '<<<< solved problem
For Each Shp In ActiveSheet.Shapes
M = 1
If Not Intersect(Shp.TopLeftCell, rngShpVal) _
Is Nothing Then
If Shp.Type = msoGroup Then
For J = 1 To Shp.GroupItems.Count
If Shp.GroupItems(J).Fill.Visible = True Then
If Shp.GroupItems(J).Fill.ForeColor. _
SchemeColor = 8 Then Let M = M + 1
End If
Next J
End If
Shp.TopLeftCell.Value = M
End If
Next Shp
End Sub

Ken Johnson

Ken,

I ran into that once and decided that Excel was reading the
dropdown arrows as shapes, but that the arrows did not have
a TopLeftCell property.

Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Ken Johnson" wrote in message oups.com...
I responded to Mihai's Compare shapes for obtaining a value post
concerning how to get a value into a cell based on the Shape in that
cell.
Mihai discovered that my suggested code (see code below) resulted in
Error 1004 if AutoFilter was turned on, otherwise it worked perfectly.
The offending code lines are "If Not Intersect(Shp.TopLeftCell,
rngShpVal) Is Nothing Then" and "Shp.TopLeftCell.Value = M", the
only lines referring to "Shp.TopLeftCell" which is causing the
error.
I have used "On Error Resume Next" just before the "For Each
Shp" loop to bypass the error message.

There are two things I don't understand:

1. Why would simply having AutoFilter just turned on, and not actually
doing any filtering (ie Show All) cause the error, and
2. Why is bypassing the error message enough to have my code work
properly, I would have expected the error to cause my code to fail.

I'm glad the code is working but I'd really like to know the inside
story behind the problem.
Any ideas?

Public Sub ShapeCellValue()
Dim Shp As Shape
Dim rngShpVal As Range
Dim J As Byte
Dim M As Byte
'Change Range("C3:F11") to suit your needs
'Grouped shapes outside this range are ignored
Set rngShpVal = _
ActiveSheet.Range("C3:F11")
rngShpVal.ClearContents
On Error Resume Next '<<<< solved problem
For Each Shp In ActiveSheet.Shapes
M = 1
If Not Intersect(Shp.TopLeftCell, rngShpVal) _
Is Nothing Then
If Shp.Type = msoGroup Then
For J = 1 To Shp.GroupItems.Count
If Shp.GroupItems(J).Fill.Visible = True Then
If Shp.GroupItems(J).Fill.ForeColor. _
SchemeColor = 8 Then Let M = M + 1
End If
Next J
End If
Shp.TopLeftCell.Value = M
End If
Next Shp
End Sub

Ken Johnson

Hi Jim,
Thanks for that, it's an interesting explanation.
Ken Johnson

Hi Jim,
On an active sheet with an AutoFilter and no shapes
ActiveSheet.Shapes(1).Name returns "Drop Down 1", so would I be right
in saying that a safer way around the problem would be...

For Each Shp in ActiveSheet.Shapes
If Left(Shp.Name,9)< "Drop Down" Then
rest of loop code
End If
Next Shp

so that those Drop Down arrows are not processed and the loop goes to
the next Shp?

Ken Johnson

Ken,

Good morning,
Since you already check for the Shape.Type why not use that
and eliminate the extra check for the Shape Name...

For Each Shp in ActiveSheet.Shapes
If Shp.Type = MsoGroup Then
If Not Intersect(Shp.TopLeftCell, rngShpVal) Is Nothing Then

Regards,
Jim Cone


"Ken Johnson" wrote in message...
Hi Jim,
On an active sheet with an AutoFilter and no shapes
ActiveSheet.Shapes(1).Name returns "Drop Down 1", so would I be right
in saying that a safer way around the problem would be...

For Each Shp in ActiveSheet.Shapes
If Left(Shp.Name,9)< "Drop Down" Then
rest of loop code
End If
Next Shp

so that those Drop Down arrows are not processed and the loop goes to
the next Shp?
Ken Johnson

Hi Jim,
thanks for that, it makes a lot of sense and should be faster.
Ken Johnson