Putting a Check or an X in cell

[Emoncada]

Is there a macro that when i click in a cell it will put a check or and X in the cell?

 

[HalfAce]

Nope, that wouldn't be all that hard to do.
Is there a column somewhere that indicates each row as good or bad?

We could also make it so each individual cell could be clicked on to change the status of
it (to checked or unchecked - whatever it isn't at the time) if you like.

Also, do you prefer the single or double click for this? (Most people seem to prefer to code
it to the double click like hatman did, (for obvious reasons) but I'm lazy and don't like having
to double click anything.)

 

[Emoncada]

Single Click would be good

 

[Emoncada]

Im going to need named ranges. How can I make that work?

 

[HalfAce]

Im going to need named ranges. How can I make that work?

Ahh, Cra . . . (darn).
I had to stop & do some work here and then wrote this up before seeing that post.

Anyway, give this a shot and see if it's what you're looking for.
Perhaps later when I have some more time, (and a good idea of your defined range names
and what they apply to) I can convert the code over to using those as well.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Not Intersect(Target, Range("G11:H11, J11:K11, M11:N11")) Is Nothing Or _
    Not Intersect(Target, Range("G28:H28, J28:K28, M28:N28")) Is Nothing Then
      Target.Resize(13).Font.Name = "Marlett"
      Select Case Target.Row
      Case 11 'Put check in all rows of range
        Select Case Target.Column
        Case 7, 10, 13
          If Target = "" Then
            Target.Resize(13).Value = "a"
            Target.Offset(, 1).Resize(13).Value = ""
            Exit Sub
          End If
          If Target <> "" Then
            Target.Resize(13).Value = ""
            Target.Offset(, 1).Resize(13).Value = "a"
            Exit Sub
          End If
        Case 8, 11, 14
          If Target = "" Then
            Target.Offset(, -1).Resize(13).Value = ""
            Target.Resize(13).Value = "a"
            Exit Sub
          End If
          If Target <> "" Then
            Target.Resize(13).Value = ""
            Target.Offset(, -1).Resize(13).Value = "a"
            Exit Sub
          End If
        End Select 'of Target.Column
      Case 28
        Select Case Target.Column
          Case 7, 10, 13
            If Target = "" Then
              Target.Resize(12).Value = "a"
              Target.Offset(, 1).Resize(12).Value = ""
              Exit Sub
            End If
            If Target <> "" Then
              Target.Resize(12).Value = ""
              Target.Offset(, 1).Resize(12).Value = "a"
              Exit Sub
            End If
          Case 8, 11, 14
            If Target = "" Then
              Target.Offset(, -1).Resize(12).Value = ""
              Target.Resize(12).Value = "a"
              Exit Sub
            End If
            If Target <> "" Then
              Target.Resize(12).Value = ""
              Target.Offset(, -1).Resize(12).Value = "a"
              Exit Sub
            End If
        End Select 'of Target.Column
      End Select 'of Target.Row
  End If
  
  If Not Intersect(Target, Range("G12:H23, J12:K23, M12:N23")) Is Nothing Or _
    Not Intersect(Target, Range("G29:H39, J29:K39, M29:N39")) Is Nothing Then
      Select Case Target.Row
      Case Is > 12, Is < 24
        Select Case Target.Column
        Case 7, 10, 13
          If Target = "" Then
            Target = "a"
            Target.Offset(, 1).ClearContents
            Exit Sub
          End If
          If Target = "a" Then
            Target.ClearContents
            Target.Offset(, 1) = "a"
            Exit Sub
          End If
        Case 8, 11, 14
          If Target = "" Then
            Target = "a"
            Target.Offset(, -1).ClearContents
            Exit Sub
          End If
          If Target = "a" Then
            Target.ClearContents
            Target.Offset(, -1) = "a"
            Exit Sub
          End If
        End Select 'of Target.Column
      Case Is > 29, Is < 40
        Select Case Target.Column
        Case 7
          If Target <> "" Then
            Target = ""
            Target.Offset(, 1) = "a"
          Else
            Target = ""
            Target.Offset(, 1) = "a"
          End If
        Case 8
          If Target <> "" Then
            Target = ""
            Target.Offset(, -1) = "a"
          Else
            Target = ""
            Target.Offset(, 1) = "a"
          End If
        End Select 'of Target.Column
      End Select 'of Target.Row
  End If
 
End Sub

 

[Jaafar Tribak]

Hi there,

There isn't an OnClick event for worksheets. Using the Selection Change event will fire when selecting a Cell using the KeyBoard as well. This is unacceptable. We want an event that fires only when a Cell is selected with the Mouse not with the keyboard.

In order to achieve a an OnClick event, I have come up with this Class named 'clsWorksheet_OnClick'.

This custom Class is instinctive and easy to use . All you need to do is create an instance of it, set its 2 Properties and run it as demonstrated below .

As its name implies, the EventProcedure Property takes the name of the custom Event Procedure that will run when mouse clicking the Worksheet whose name is to be assigned to the 'WorkSheetName' Property.

The Event Procedure is to be defined by the developper whenever an instance of the Class is created and will be defined as Private Sub WorkSheet_OnMouseClick(ByVal Target As Range) in keeping with the standard signature, feel and look of native Event Procedures.

This will also make coding cleaner and more flexible.

Here is a download demo : http://www.savefile.com/files/134269
Note: Will have to save the download to disk as it might not work otherwise !

Here is an implementation of the Class that simply places\toggles an X mark on the cells within the range A1:A20 in Sheet1 upon mouse clicking them.
Code:

Create a Class Module, name it 'clsWorksheet_OnClick' and place the following code in it:

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Long

Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
(lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Const WM_MOUSEMOVE = &H200
Private Const MK_RBUTTON = &H2
Private Const PM_NOREMOVE = &H0
Private Const PM_NOYIELD = &H2

Private sWorkSheetName As String
Private sEventProc As String

Public WithEvents Worksheet As Excel.Worksheet


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim lngArr() As Variant
    Dim Item As Variant
    Dim lngXLhWnd As Long
    Dim mssg As MSG
    
    lngArr = Array(vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyTab, vbKeyReturn _
    , vbKeyHome, vbKeyEnd, vbKeyPageDown, vbKeyPageUp)
    
    '\ check if any of the navigation keys are pressed
    For Each Item In lngArr
    
        '\ if so, skip the event handler
        If CBool(GetAsyncKeyState(Item) And &H8000) Then
            Exit Sub
        End If
        
    Next
    
    '\ ok, we got here it means the sheet has been navigated with the mouse
    '\ so we are ready to execute the selection_change event handler.
    '\ but first,let's find out which mouse button was clicked.
    
    '\ get the XL app window handle
    lngXLhWnd = FindWindow("XLMAIN", Application.Caption)
    
    '\ check for the WM_MOUSEMOVE in the app window message queue
     PeekMessage mssg, lngXLhWnd, WM_MOUSEMOVE, WM_MOUSEMOVE, PM_NOREMOVE + PM_NOYIELD
      
     '\ if a WM_MOUSEMOVE is detected and the mouse right button
     '\ wasn't down then proceed with your code
     If mssg.message = WM_MOUSEMOVE And mssg.wParam <> MK_RBUTTON Then
     
     '\\call the user callback procedure passing the param Terget to it
     Run ThisWorkbook.Name & "!" & sEventProc, Target
     
     End If

End Sub


Public Property Let WorkSheetName(ByVal sNewValue As String)

    sWorkSheetName = sNewValue

End Property

Public Sub Execute()

    Set Me.Worksheet = Worksheets(sWorkSheetName)

End Sub

Public Property Let EventProcedure(ByVal sNewValue As String)

    sEventProc = sNewValue

End Property

To use this Class, place this in Standard Module and run the 'StartOnMouseClickEvent' routine :

Option Explicit

Dim oTestOnMouseClick As clsWorksheet_OnClick


'\\action this mouse click event
Sub StartOnMouseClickEvent()

    '\\create an instance of the Class
    Set oTestOnMouseClick = New clsWorksheet_OnClick
    
    '\\set its attributes and action it
    With oTestOnMouseClick
        .WorkSheetName = ThisWorkbook.Worksheets(1).Name
        .EventProcedure = "WorkSheet_OnMouseClick"
        .Execute
    End With

End Sub


'\\do whatever you want in this custom event routine
'\\just as you would with a native worksheet event procedure
Private Sub WorkSheet_OnMouseClick(ByVal Target As Range)

    '\\this will toggle placing an 'X'mark in the clicked cell
    If Union(Target, Range("A1:A20")).Address = Range("A1:A20").Address Then
        If Target.Cells.Count = 1 Then
            If UCase(Target) = "X" Then
                Target.ClearContents
                ElseIf IsEmpty(Target) Then
                Target = "X"
            End If
        End If
    End If

End Sub


'\\remove this custom mouse click event
Sub StopOnMouseClickEvent()

    Set oTestOnMouseClick = Nothing

End Sub

Regards.

 

[HalfAce]

Jaafar,
Wow. That is cool! An OnClick event.
I'm going to have to go through it more carefully and get more familiar with it.
The commenting looks to be helpful.
I can see this being very handy.

 

[Jaafar Tribak]

Jaafar,
Wow. That is cool! An OnClick event.
I'm going to have to go through it more carefully and get more familiar with it.
The commenting looks to be helpful.
I can see this being very handy.

Thanks for the feedback HalfAce.

I like to be able to capture events that don't exist natively in XL.
This involves some coding but I believe it's worth the effort.

Regards.

 

[hatman]

Jafaar... thats looks very cool. But what hapens if the cursor is already in a cell, and you click that cell. A quick inspection of your code looks like the click event would be ignored... am I wrong?

 

[Jaafar Tribak]

Jafaar... thats looks very cool. But what hapens if the cursor is already in a cell, and you click that cell. A quick inspection of your code looks like the click event would be ignored... am I wrong?

Nice catch hatman !

I am off to work right now. Ill look into this again and get back later.

Regards.

 

[ajgolfs]

Like this:

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

    If Intersect(Range("Check"), Target) Is Nothing Then
    
        Exit Sub
        
    End If
    
    If Target.Value = "X" Then
    
        Target.Value = ""
        
    Else
    
        Target.Value = "X"
        
    End If
    
    Cancel = True
    
End Sub

where Check is a named range containing all the cells where you want this to apply... cells need not be contiguous. I tweaked it so that you can toggle the X...

How would I modify this code so when it would go from X to Y and then back to a blank. Basically, I'm trying to make it so when I double click a cell, and X will appear, if I double click a second time, a Y will appear, and if done a third time, the cell goes blank. Any help would be much appreciated. Thanks in advance!