Mysterious Error 1004 caused by AutoFilter?
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
|