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" wrote:

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" wrote:

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" wrote:

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" wrote:

Joel,

This new code removes all the shapes in the cells selected. However,
instead of removing all the shapes and showing the message all at once,
removal is done based on each group of cells selected. For example, if I
have selected 4 groups of cells (using Ctrl key), the macro will remove 4
times and show message four times for each group of cells. In addition, the
counter (cCount) within the message is not counting correctly. It seems
double after removing 2nd group of shapes (cells).

Please help. Thank you very much for your help and patience.

"Joel" wrote:

Here is a simple modification to handle all seleted areas.


Sub test()

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

For Each myRange In Selection.Areas

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
MsgBox "You have removed " & cCount & _
" check marks in highlighted cells " _
& myRange.Address & "' of the Worksheet '" & _
ActiveSheet.Name & "'."
Next myRange
End Sub

"Please Help" wrote:

Joel,

Thank you again for your patience and your continuing help.

I think we are almost there. When I try your latest code, I got no error
message, and it removed the shapes. However, it does not remove all the
shapes.

For example, if I selected the cells B4:E9, B17, E18 and H11. It removed
the shapes only in the cells B4:E9. There were total of 9 shapes, and cells
B4:B9 has 6 shapes. I also tried it by selecting 2 large range (F4:I11 and
D16:F22) of cells (instead of one large range and individual cells like the
first example), and it deleted the shapes in the first range.

Based on the testing, the macro only removes the shapes in the first cell or
first group of cells. The shapes of the rest of selected cells (selecting
using the Ctrl key) do not get removed.

Thanks.



"Joel" wrote:

I modified the code to work off selected cells


Sub test()

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

Set myRange = Selection
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
MsgBox "You have removed " & cCount & " check marks in highlighted cells
" _
& myRange.Address & "' of the Worksheet '" & ActiveSheet.Name & "'."
End Sub

"Please Help" wrote:

Joel,

The range is pretty much any cell on the sheet, not just A1 and E5.
Meaning, we could have shapes in cells A1, E5, G100:I110, etc.

From your post, you asked me to change the MsgBox. Does it mean the new one
will not reference the cells where we are removing the shapes? Is it
possible to reference them in the Msgbox?

Thanks.

"Joel" wrote:

sCells is not defined. You are going to have to set the range by changint
the A1 and E5.

from
MsgBox "You have removed " & cCount & " check marks in highlighted cells "
'" & sCells.Name & "' of the Worksheet '" & ActiveSheet.Name & "'."
to
MsgBox "You have removed " & cCount & " check marks in highlighted cells "
& "' of the Worksheet '" & ActiveSheet.Name & "'."


"Please Help" wrote:

Joel,

Thanks for your patience and your continuing help.

I changed the code to ActiveSheet as you indicated below, and I am still
getting the same error message.

However, this time it pointed me to the MsgBox:

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

Please help.

Thanks.


"Joel" wrote:

from
For Each cMarks In sCells.Shapes
to
For Each cMarks In ActiveSheet.Shapes


"Please Help" wrote:

Joel,

Thanks for the code. When I run your code, I got the following error:

Run-time error '91': Object variable or With block variable not set

And it pointed me to the line "For Each cMarks In sCells.Shapes".

I am just curious something. How does the code know the range for "sCells"
because there is no reference for range for sCells?

Thanks.

"Joel" wrote:

I forgot to post my code. All shapes have four location/size parameters
Top, Left, Height, Width

Sub test()

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

RLeft = Range("A1").Left