Using VBA in EXCEL to add a checkmark to a cell

[Robert_Conklin]

I use the checkmark symbol a lot and I would like to use a macro to add a checkmark to a cell that I select. I tried recording a macro to add a checkmark to a selected cell but I need it set up so that it will place a checkmark in any cell that I select, not just the one that the recording filled in. Below is the recorded macro;

Sub Insert_A_Checkmark()

' Insert_A_Checkmark Macro

    ActiveCell.FormulaR1C1 = "ü"
    Range("G18").Select
End Sub

Any help would be greatly appreciated.

 

[cmowla]

In a standard code module (where your old sub is), this is code to put a green checkmark centered horizontally and vertically:

Sub Test__Insert_Symbol_On_ThisTile()
Call Insert_Symbol_In_This_Cell(ActiveCell.Address, "00FC", "Wingdings")
End Sub
Sub Insert_Symbol_In_This_Cell(cellAddress As String, hexcode As String, fontName As String)
With Range(cellAddress)
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Font.Color = RGB(0, 255, 0)
    .Value = ChrW("&h" & hexcode)
    .Font.Name = LCase(fontName)
End With
End Sub

Now right click on the sheet tab name of the sheet that you want this to happen and click View Code:

And copy the following code into there:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then Call Insert_Symbol_In_This_Cell(Target.Address, "00FC", "Wingdings")
End Sub

EDIT:

But the above sheetcode will only put checkmarks! If you want it to remove the checkmark if you click on a cell that has one (but not on the same cell that you just put one but didn't make another selection first), then use this code in the sheet instead.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then
    If Trim(Target.Value) = ChrW("&h" & "00FC") Then
        Target.Value = ""
    ElseIf Trim(Target.Value) = "" Then
        Call Insert_Symbol_In_This_Cell(Target.Address, "00FC", "Wingdings")
    Else:
    End If
End If
End Sub

 

[Robert_Conklin]

That worked beautifully!! Thank you so much, cmowla!

 

[cmowla]

I like green checkmarks myself, but you can change the color from the RGB (obviously).

And I find that if you would use right click instead of left click, it's better because you can right click on the same cell twice in a row and it will toggle the checkmark without any issue:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count = 1 Then
    If Trim(Target.Value) = ChrW("&h" & "00FC") Then
        Cancel = True
        Target.Value = ""
    ElseIf Trim(Target.Value) = "" Then
        Cancel = True
        Call Insert_Symbol_In_This_Cell(Target.Address, "00FC", "Wingdings")
    Else:
    End If
End If
End Sub

But the choice is yours.

 

[cmowla]

But another option is to have left click, but have it move to a cell down (or over, if you change Target.Offset(1,0).Select to Target.Offset(0,1).Select) from the one you just selected. This way, you can toggle without any issues . . . except that the selected cell will no longer be the active cell by the end of the sub:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then
    If Trim(Target.Value) = ChrW("&h" & "00FC") Then
        Target.Value = ""
        Application.EnableEvents = False
        Target.Offset(1, 0).Select
        Application.EnableEvents = True
    ElseIf Trim(Target.Value) = "" Then
        Call Insert_Symbol_In_This_Cell(Target.Address, "00FC", "Wingdings")
        Application.EnableEvents = False
        Target.Offset(1, 0).Select
        Application.EnableEvents = True
    Else:
    End If
End If
End Sub

 

[Robert_Conklin]

I like green checkmarks myself, but you can change the color from the RGB (obviously).

And I find that if you would use right click instead of left click, it's better because you can right click on the same cell twice in a row and it will toggle the checkmark without any issue:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count = 1 Then
    If Trim(Target.Value) = ChrW("&h" & "00FC") Then
        Cancel = True
        Target.Value = ""
    ElseIf Trim(Target.Value) = "" Then
        Cancel = True
        Call Insert_Symbol_In_This_Cell(Target.Address, "00FC", "Wingdings")
    Else:
    End If
End If
End Sub

But the choice is yours.

I like this one better. I replaced the first code with this and it works great! Thanks again.