Click on a cell and have check mark displayed in MS Excel

O

ogopogo5

I would like to be able to click on a cell and have a check mark
displayed in a cell. Then click on the cell again to disappear. Also
indicate what cell range will display the check mark.

Thank you in advance.



*** Sent via Developersdex http://www.developersdex.com ***
 
O

OssieMac

Needs to be a Double click so that it will fire an event on Double Click.
Can't do it on single click.

Copy the following code into the Sheet module in the VBA editor. If you need
instructions to do this then get back to me.

Edit the range "A1:G10" to the range that you want to use for the
check marks to be inserted/deleted.

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)

Dim isect As Object

'Test if target in required range
Set isect = Application.Intersect(Target, Range("A1:G10"))

If Not isect Is Nothing Then
'Cancel Edit mode invoked by double click
Cancel = True

'Test if cell already contains check mark
If ActiveCell = Chr(252) Then
'Clear check mark
ActiveCell.ClearContents
Else
'Insert check mark code
ActiveCell = Chr(252)
'Change font to Wingdings
With ActiveCell.Characters _
(Start:=1, Length:=1).Font

.Name = "Wingdings"

End With
End If
End If

End Sub
 
O

OssieMac

My apologies. My comment "Can't do it on single click" is not correct. You
could use the following and it will place/remove a check mark on a cell when
the cell is selected. However, it doesn't matter whether selected by clicking
on the cell or using the arrow keys to select. I think that double click
method is better but here is the code to simply click if you want it. Place
it in the Sheet module.

Note that the sub names in both of my replies are critical. You can't use a
different sub name or place the following code in the Double click sub.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect As Object

'Test if target in required range
Set isect = Application.Intersect(Target, Range("A1:G10"))

If Not isect Is Nothing Then

'Test if cell already contains check mark
If ActiveCell = Chr(252) Then
'Clear check mark
ActiveCell.ClearContents
Else
'Insert check mark code
ActiveCell = Chr(252)
'Change font to Wingdings
With ActiveCell.Characters _
(Start:=1, Length:=1).Font

.Name = "Wingdings"

End With
End If
End If

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top