Please help with my code

[Joel]

Glad the problem is so simple. Just moving one line of code should fix
problem I'm also initializing the count just in case of problems. I also
made a changge so the address printed in the msgbox contains all the
addresses.


Sub test()

Dim cMarks As Shape
Dim sCells As Range
Dim cCount As Integer

cCount = 0
address_string = ""
For Each myRange In Selection.Areas

if address_string = "" then
address_string = myRange.address
else
address_string = address_string & "," & _
myRange.address
end if
myRows = myRange.Rows.Count
LastRow = myRange.Row + myRows - 1
myCols = myRange.Columns.Count
LastCol = myRange.Column + myCols - 1
Set LastCell = Cells(LastRow, LastCol)

RLeft = myRange.Left
RTop = myRange.Top
RRight = LastCell.Left + LastCell.Width
RBottom = LastCell.Top + LastCell.Width

For Each cMarks In ActiveSheet.Shapes
If cMarks.Type = 13 Then
If cMarks.Top >= RTop And _
cMarks.Top <= RBottom And _
cMarks.Left >= RLeft And _
cMarks.Left <= RRight Then

cCount = cCount + 1
cMarks.Delete
End If
End If
Next cMarks
Next myRange

MsgBox "You have removed " & cCount & _
" check marks in highlighted cells " _
& address_string & "' of the Worksheet '" & _
ActiveSheet.Name & "'."

End Sub

 

[Please Help]

Joel,

This new code seems to work. It removes the shapes on the cells that I
selected and gives me a message all at once, except one problem.

I don't know what causes it. Sometimes, in addition to removing the shapes
for the selected cells, it also removes the shapes next to those cells. For
example, I selected B3 and B12, and it also removed the shapes in C4.

One thing I don't know I should let you know. Sometimes, we may have more
than one shape in a cell. For example, Cell B1 may have 3 shapes (and
usually they are different shapes). However, the cells for the example that
I mentioned above contain only one shape. I also tried on a cell with
multiple shapes, and it would cause the same problem. I don't think the
problem is one shape or multiple shapes in a cell.

Thanks.

 

[Joel]

There are two reason for deleting the cell to the right.

1) the shape is right on the edge between the two cells. Possibly change
the <= to just < might fix the problem

from
If cMarks.Top >= RTop And _
cMarks.Top <= RBottom And _
cMarks.Left >= RLeft And _
cMarks.Left <= Rright Then
to
If cMarks.Top >= RTop And _
cMarks.Top < RBottom And _
cMarks.Left >= RLeft And _
cMarks.Left < Rright Then

2) I don't know how accurate the check marks werer placed on the worksheet.
It is possible the left side of check mark is in the cell to the left. The
code can't fix this problem. Can you tell me how the check marks were put
into the worksheet?

 

[Please Help]

We have a toolbar of shapes. What we do is we select a cell where we want to
place the shape to, and we click on the shape that we want on the toolbar.
The shape then places in the cell. Sometimes, we move the shape to a
different cell or a different place (e.g. right of the cell) in that cell
that we selected.

Thanks.

 

[Joel]

You r method of placing the shape on the worksheet is not very precise. The
problem just may be you arre within the limits of the box to the left. The
other problem is if you resize a column the shape doesn't move. It may end
up on a different column.

You may want to write a macro that adds the check mark. Highlight cells and
then run the macro to put the check marks onto the sheets.

Do you use linked cells with your check mark? You could highlight the
linked cells and remove the check marks based on the linked cell rather than
the cells the check marks are sitting on.

 

[Please Help]

Joel,

Thanks again very much for your help and patience. I know sometimes it is
hard to write a code when we are dealing with shapes.

Yes, we may use shapes on the linked cells.

Unfortunately, I can write a code to add the shapes because shapes are
different and we use a lot of different types of shapes.

Would you mind explain to me about your code on why you have to come up
with? I would love to learn from this experience.

Thanks. Have a safe and nice holiday season!