How do I fill a cell with text automatically when I click on the cell?

R

Reiper79

New Member
Joined
Jun 15, 2021
Messages
21
Office Version
  1. 365
Platform
  1. Windows
Hi.

Is it possible to insert the letter "x" into a cell automatically whenever any cell in a range is clicked on with the mouse?

If so, can someone be kind enough to show me how, please?

Thanks.
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
Is it also possible to do the same task by highlighting more than one cell in the range?

Thanks.
 
Upvote 0
Excel doesn't provide a propper Click event. The closest is to use the worksheet selection_change event. Unfortunately, this event also fires when selecting cells with the keyboard navigation keys hence it is of no use. Trapping mouse clicks in excel is not easy. Setting a Windows mouse hook, subclassing the excel application or using a Windows timer would work but it would make excel unstable and potentially crash the entire application.

I use a hacky alternative which works for trapping mouse clicks on cell(s) exclusively and ignores keyboard selections/navigation. It is not super fast but it is acceptable and most importantly, it won't make excel unstable and won't crash the application should an unhadled error occur..

File Demo:
CellClickEvent_.xlsm






1- Class Module code : (CCellClickEvent)
VBA Code: 
Option Explicit

Public Event SheetClick(ByVal Sh As Worksheet, ByVal Target As Range, ByRef DisableDBlClick As Boolean)

Private WithEvents cmbrs As CommandBars
Private WithEvents wb As Workbook
Private bDisbaleDBlClick As Boolean

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type KeyboardBytes
     kbByte(0& To 255&) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
    Private Declare PtrSafe Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#Else
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
    Private Declare Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#End If

Public Sub AddCellClickEvent()
    Set wb = ThisWorkbook
    Set cmbrs = Application.CommandBars
    Call cmbrs_OnUpdate
End Sub

Private Sub cmbrs_OnUpdate()
    Dim tCurPos As POINTAPI
    Dim bTmpDisbaleDBlClick As Boolean
    On Error GoTo errHandler
    If GetActiveWindow = Application.Hwnd Then
        If ActiveWorkbook Is ThisWorkbook Then
            If TypeName(ActiveWindow.Selection) = "Range" Then
                Call GetCursorPos(tCurPos)
                If TypeName(ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)) = "Range" Then
                    If GetKeyState(VBA.vbKeyLButton) And &H1& = 1& Then
                        RaiseEvent SheetClick(ByVal ActiveSheet, ByVal ActiveWindow.RangeSelection, bTmpDisbaleDBlClick)
                        bDisbaleDBlClick = bTmpDisbaleDBlClick
                    End If
                End If
            End If
        End If
    End If
    SetKeyStateBitToZero VBA.vbKeyLButton
    Exit Sub
errHandler:
    Call Me.AddCellClickEvent
End Sub

Private Sub SetKeyStateBitToZero(ByVal Key As Integer)
    Dim kbArray As KeyboardBytes
    Call GetKeyState(Key)
    Call GetKeyboardState(kbArray)
    kbArray.kbByte(Key) = (kbArray.kbByte(Key) And (Not &H1&))
    Call SetKeyboardState(kbArray)
End Sub

Private Sub wb_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If bDisbaleDBlClick = True Then Cancel = True
End Sub

Private Sub Class_Terminate()
    Set wb = Nothing
    Set cmbrs = Nothing
End Sub


2- Event Handler Code in the ThisWorkbook Module:
VBA Code: 
Option Explicit

Private WithEvents Workbook_ As CCellClickEvent

Private Sub Workbook_Open()
    Call SetClickEvent
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Workbook_ Is Nothing Then Call SetClickEvent
End Sub

Private Sub SetClickEvent()
    Set Workbook_ = New CCellClickEvent
    Workbook_.AddCellClickEvent
End Sub


' ______________________________________ Cell Click Event Handler ________________________________________

Private Sub Workbook__SheetClick(ByVal Sh As Worksheet, ByVal Target As Range, ByRef DisableDBlClick As Boolean)
       
    Dim oRange As Range, oCell As Range
    Const TARGET_RANGE = "B4:H12"
   
    If Sh Is Sheet1 Then
        Set oRange = Intersect(Target, Range(TARGET_RANGE))
        If Not oRange Is Nothing Then
            With oRange
                .Font.Name = "Wingdings"
                .Font.Size = 20&
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                If Not oRange Is Nothing Then
                    Application.EnableCancelKey = xlDisabled
                    DisableDBlClick = True '<== Optional: disable dblclick for smoother experience.
                    'Toggle Cell values.
                    For Each oCell In .Cells
                        oCell.Value = IIf(oCell.Value = "J", "L", "J")
                        oCell.Font.Color = IIf(oCell.Value = "J", vbRed, vbBlue)
                    Next
                End If
            End With
        End If
    End If
     
End Sub



Is it possible to insert the letter "x" into a cell automatically whenever any cell in a range is clicked on with the mouse?
Click to expand...
In your case, you will just have to edit the event handler code that is located in the ThisWorkbook module as a minimum as follows:
VBA Code: 
Private Sub Workbook__SheetClick(ByVal Sh As Worksheet, ByVal Target As Range, ByRef DisableDBlClick As Boolean)
    Target.Value = "X"
End Sub

Notice the Sh, Target and DisableDBlClick arguments. You can use/set them to restrict/specify the span of action to which the code will be applied, just like we do with standard native events.
 
Upvote 0
Jaafar Tribak said:
The closest is to use the worksheet selection_change event. Unfortunately, this event also fires when selecting cells with the keyboard navigation keys hence it is of no use.
Click to expand...
@Reiper79
Maybe selecting with the keyboard might also suit the you? If so, you could try this much simpler Worksheet_SelectionChange code with a copy of your workbook (changing the relevant range as required).
Post back if you need instructions on how to implement it.

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rSelected As Range
  
  Set rSelected = Intersect(Target, Range("B2:F20"))
  If Not rSelected Is Nothing Then rSelected.Value = "x"
End Sub
 
Upvote 0
Jaafar Tribak said:
Excel doesn't provide a propper Click event. The closest is to use the worksheet selection_change event. Unfortunately, this event also fires when selecting cells with the keyboard navigation keys hence it is of no use. Trapping mouse clicks in excel is not easy. Setting a Windows mouse hook, subclassing the excel application or using a Windows timer would work but it would make excel unstable and potentially crash the entire application.

I use a hacky alternative which works for trapping mouse clicks on cell(s) exclusively and ignores keyboard selections/navigation. It is not super fast but it is acceptable and most importantly, it won't make excel unstable and won't crash the application should an unhadled error occur..

File Demo:
CellClickEvent_.xlsm






1- Class Module code : (CCellClickEvent)
VBA Code: 
Option Explicit

Public Event SheetClick(ByVal Sh As Worksheet, ByVal Target As Range, ByRef DisableDBlClick As Boolean)

Private WithEvents cmbrs As CommandBars
Private WithEvents wb As Workbook
Private bDisbaleDBlClick As Boolean

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type KeyboardBytes
     kbByte(0& To 255&) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
    Private Declare PtrSafe Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#Else
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
    Private Declare Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#End If

Public Sub AddCellClickEvent()
    Set wb = ThisWorkbook
    Set cmbrs = Application.CommandBars
    Call cmbrs_OnUpdate
End Sub

Private Sub cmbrs_OnUpdate()
    Dim tCurPos As POINTAPI
    Dim bTmpDisbaleDBlClick As Boolean
    On Error GoTo errHandler
    If GetActiveWindow = Application.Hwnd Then
        If ActiveWorkbook Is ThisWorkbook Then
            If TypeName(ActiveWindow.Selection) = "Range" Then
                Call GetCursorPos(tCurPos)
                If TypeName(ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)) = "Range" Then
                    If GetKeyState(VBA.vbKeyLButton) And &H1& = 1& Then
                        RaiseEvent SheetClick(ByVal ActiveSheet, ByVal ActiveWindow.RangeSelection, bTmpDisbaleDBlClick)
                        bDisbaleDBlClick = bTmpDisbaleDBlClick
                    End If
                End If
            End If
        End If
    End If
    SetKeyStateBitToZero VBA.vbKeyLButton
    Exit Sub
errHandler:
    Call Me.AddCellClickEvent
End Sub

Private Sub SetKeyStateBitToZero(ByVal Key As Integer)
    Dim kbArray As KeyboardBytes
    Call GetKeyState(Key)
    Call GetKeyboardState(kbArray)
    kbArray.kbByte(Key) = (kbArray.kbByte(Key) And (Not &H1&))
    Call SetKeyboardState(kbArray)
End Sub

Private Sub wb_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If bDisbaleDBlClick = True Then Cancel = True
End Sub

Private Sub Class_Terminate()
    Set wb = Nothing
    Set cmbrs = Nothing
End Sub


2- Event Handler Code in the ThisWorkbook Module:
VBA Code: 
Option Explicit

Private WithEvents Workbook_ As CCellClickEvent

Private Sub Workbook_Open()
    Call SetClickEvent
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Workbook_ Is Nothing Then Call SetClickEvent
End Sub

Private Sub SetClickEvent()
    Set Workbook_ = New CCellClickEvent
    Workbook_.AddCellClickEvent
End Sub


' ______________________________________ Cell Click Event Handler ________________________________________

Private Sub Workbook__SheetClick(ByVal Sh As Worksheet, ByVal Target As Range, ByRef DisableDBlClick As Boolean)
      
    Dim oRange As Range, oCell As Range
    Const TARGET_RANGE = "B4:H12"
  
    If Sh Is Sheet1 Then
        Set oRange = Intersect(Target, Range(TARGET_RANGE))
        If Not oRange Is Nothing Then
            With oRange
                .Font.Name = "Wingdings"
                .Font.Size = 20&
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                If Not oRange Is Nothing Then
                    Application.EnableCancelKey = xlDisabled
                    DisableDBlClick = True '<== Optional: disable dblclick for smoother experience.
                    'Toggle Cell values.
                    For Each oCell In .Cells
                        oCell.Value = IIf(oCell.Value = "J", "L", "J")
                        oCell.Font.Color = IIf(oCell.Value = "J", vbRed, vbBlue)
                    Next
                End If
            End With
        End If
    End If
    
End Sub




In your case, you will just have to edit the event handler code that is located in the ThisWorkbook module as a minimum as follows:
VBA Code: 
Private Sub Workbook__SheetClick(ByVal Sh As Worksheet, ByVal Target As Range, ByRef DisableDBlClick As Boolean)
    Target.Value = "X"
End Sub

Notice the Sh, Target and DisableDBlClick arguments. You can use/set them to restrict/specify the span of action to which the code will be applied, just like we do with standard native events.
Click to expand...
Thanks very much mate. I'll give it a go and let you know how I go.
 
Upvote 0
Peter_SSs said:
@Reiper79
Maybe selecting with the keyboard might also suit the you? If so, you could try this much simpler Worksheet_SelectionChange code with a copy of your workbook (changing the relevant range as required).
Post back if you need instructions on how to implement it.

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rSelected As Range
 
  Set rSelected = Intersect(Target, Range("B2:F20"))
  If Not rSelected Is Nothing Then rSelected.Value = "x"
End Sub
Click to expand...
Thanks very much Peter. I'll have a play with both options and see what happens. I'll let you know also what happens.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Automatic cell height adjustment
Replies
4
Views
163
TPFKAS
T
K
  • Question Question
Stocktake of Barcoded Inventory in Excel using a Barcode Scanner
Replies
2
Views
122
Kobus Horn
K
P
  • Solved
Copy and Re-Name Worksheet using a cell value.
Replies
3
Views
118
Logit
Logit
P
  • Solved
New Worksheet Hyperlinks
2
Replies
12
Views
164
Peter_SSs
Peter_SSs
M
  • Solved
Populate a cell with text and formatting based on a whether a date field falls within a date range
Replies
3
Views
143
Micron
M

Forum statistics

Threads
1,223,896
Messages
6,175,263
Members
452,627
Latest member
KitkatToby

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top