Enter check mark with one cell click, and ability to change selection in a range

[HughT]

I am creating a form where the user is to select one option only from a range of five cells in a row.

I want the user to be able to select a cell within a range and insert a check mark with one click, and delete any previous check marks within the range. The user must also be able to delete all check marks (eg by use of Delete key)

So, range A1:E1

User clicks B1, check mark is inserted
User then clicks C1, check mark is deleted from B1, check mark is inserted in C1

Many thanks, VBA newbie, and as I want to use this function on different rows and columns, detailed instructions on how to change code would be appreciated!

HughT

 

[HughT]

Mick

Thank you again

Hugh

 

[HughT]

Mick

Using the Tab key or Enter key has the effect of moving the check mark either to the right (Tab key) or downwards (Enter key) which could have horrible consequences if it wasn't spotted.

Is it possible to inhibit these so that the check mark can only be entered on mouse click?

Sorry to be a nuisance

Regards

Hugh

 

[MickG]

You will need to add the code as shown below:-

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then '<<<<<<<:- Add this line
Application.OnKey "{TAB}", ""
Application.OnKey "{LEFT}", ""
Application.OnKey "{RIGHT}", ""
Application.OnKey "{UP}", ""
Application.OnKey "{DOWN}", ""
Application.OnKey "{RETURN}", ""
If Not Intersect(Target, Range("A1:E200")) Is Nothing Then


With Target
    Cells(.Row, .Column - (.Column - 1)).Resize(, 5).ClearContents
End With
With Target
    .Font.Name = "Wingdings"
    .Value = Chr(252)
End With
ElseIf Not Intersect(Target, Range("N1:S200")) Is Nothing Then
Application.OnKey "{TAB}", ""
Application.OnKey "{LEFT}", ""
Application.OnKey "{RIGHT}", ""
Application.OnKey "{UP}", ""
Application.OnKey "{DOWN}", ""
Application.OnKey "{RETURN}", ""
With Target
    Cells(.Row, .Column - (.Column - 14)).Resize(, 5).ClearContents
End With
With Target
    .Font.Name = "Wingdings"
    .Value = Chr(252)
End With
Else
Application.OnKey "{TAB}"
Application.OnKey "{LEFT}"
Application.OnKey "{RIGHT}"
Application.OnKey "{UP}"
Application.OnKey "{DOWN}"
Application.OnKey "{RETURN}"
End If
End If   '<<<<<<<:- Add this line
End Sub