Trapping left mouse click event.

S

Saee Mane

New Member
Joined
Aug 30, 2021
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Hi All,

Is there a simple way for trapping left mouse click event in a specified range in excel?

Basically my requirement is when I left click on any cell specified in the given range it should mark as "TRUE" and again when I left click the same cell it shoud mark as "FALSE".

Your assistance will be highly appreciated.
Thank you in advance!
 
Sort by date Sort by votes
T
Gokhan Aycan said:
Yes, all possible. Paste the following subs in a module (in my case Module1). I assumed ActiveSheet.

With the below subs you can create shapes in 2 ways:

1. Use the run macro list (ALT + F8) to run "Create Buttons". Any selected cell will be populated with shapes.

2. Call the "Create_Buttons_From_Range" macro with Call Module1.Create_Buttons_From_Range(Your_Range_Here) in your code.
Range is optional, which in that case will be the current selection.

Either case: Modify shp.OnAction = "Module1.Button_Test"
Change "Module1" to your module name where Button_Test is located.
Change "Button_Test" accordingly (post #7)

Note: Using Option Private Module at the top of the module would hide Public Subs from the run macro list, they would still be accessible by "Module_Name.Sub_Name".

Jaafar Tribak's solutions (post #6) may look intimidating but they are extremely nice. Definitely take a look at that if somehow this won't suit you.

VBA Code: 
Public Sub Create_Buttons()

    Call Create_Buttons_From_Range(Selection)

End Sub

Public Sub Create_Buttons_From_Range(Optional ByVal rng As Range)
   
    Dim cCell As Range
    Dim shp As Shape
   
    If rng Is Nothing Then Set rng = Selection
   
    For Each cCell In rng
       
        On Error Resume Next
        Set shp = ActiveSheet.Shapes("Cell_" & Replace(cCell.Address, "$", ""))
        On Error GoTo 0
       
        If shp Is Nothing Then
            Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, cCell.Left, cCell.Top, cCell.Width, cCell.Height)
            shp.Name = "Cell_" & Replace(cCell.Address, "$", "")
            shp.OnAction = "Module1.Button_Test"
            shp.Fill.Transparency = 1
            shp.Line.Visible = msoFalse
            shp.Placement = xlMoveAndSize
            Set shp = Nothing
        End If
       
    Next cCell
   
End Sub
Click to expand...
Thank you Gokhan Aycan for your suggestion!

The code looks pretty easy to understand but unfortunately I am unable to integrate that code in excel file.

Can you please send the sample of excel file where you have implemented both the codes.

I am working on the project in excel where users are required to answer around 20-30 questions in the "TRUE and FALSE" form and if there is data validation in any cell then code should not affect that cell.
 
Upvote 0

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Saee Mane said:
In addition if any cell contains data validation (drop-down) then code should not affect that cell.
Click to expand...
Don't know about the other methods, but that can be done easily with my suggestion.
VBA Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B2:C10")) Is Nothing Then
    On Error Resume Next
    If Target.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
        Cancel = True
        Target.Value = (Target.Value = False)
    End If
    On Error GoTo 0
End If
End Sub
 
Upvote 0
Data validation should not be an issue, it would actually be better. However, I possibly won't have the time until evening (7-8 hours).

Some questions:
What will be the default value of these cells?
Need clarification: If there is data validation in a cell, don't create a shape?

Also, I realize that in your first post, you asked for true/false. My example was yes/no. Sorry for that.

Edit: While working on my last project, I learned that setting a cell value to true/false is not a very good thing, as they are changed to the corresponding words depending on language settings. Instead setting cell values with strings "true"/"false" solved it for me. Hope that makes sense.
 
Upvote 0
Gokhan Aycan said:
Data validation should not be an issue, it would actually be better. However, I possibly won't have the time until evening (7-8 hours).

Some questions:
What will be the default value of these cells?
Need clarification: If there is data validation in a cell, don't create a shape?

Also, I realize that in your first post, you asked for true/false. My example was yes/no. Sorry for that.

Edit: While working on my last project, I learned that setting a cell value to true/false is not a very good thing, as they are changed to the corresponding words depending on language settings. Instead setting cell values with strings "true"/"false" solved it for me. Hope that makes sense.
Click to expand...
Initially the cell will be blank and there will be no any value present. When user will click on the cell it should reflect "True" and when clicked 2nd time on the same cell it should reflect "False".

In addition to that,
let's say I assign the Range("A1:A30" ) where I want the code to be runned but if cell A5 already contains data validation then code should not affect that particular cell.

In terms of coding I can say "If there is any data validation in a cell then don't create a shape"

I hope this answers your question.
If still any ambiguity please let me know.
 
Upvote 0
I've already done what you are asking with the double click code a couple of posts earlier.
 
Upvote 0
jasonb75 said:
I've already done what you are asking with the double click code a couple of posts earlier.
Click to expand...
Apologize for late reply.

Firstly thank you for the code. I tried the code and it is working exactly the way I want.

The same thing I am expecting with single left click if it is possible. I know there is no such left click event but there can be some other method through which we can get the same result with single left click.
 
Upvote 0
The following code is all there is, and everything is on Module1. Only sheet is Sheet1.

1630450152954.png


VBA Code: 
Option Explicit
'Option Compare Text
'Option Private Module

Public Sub Button_Test()
   
    Dim cCell As Range
   
    Set cCell = Range(Right(Application.Caller, Len(Application.Caller) - Len("Cell_")))
   
    If UCase(cCell.Value) = "TRUE" Then
        cCell.Value = "False"
    Else
        cCell.Value = "True"
    End If
   
    Set cCell = Nothing
   
End Sub

Public Sub Create_Buttons()

    Call Module1.Create_Buttons_From_Range(Selection)

End Sub

Public Sub Create_Buttons_From_Range(Optional ByVal rng As Range)
   
    Dim cCell As Range
    Dim shp As Shape
    Dim strValidation As String
   
    If rng Is Nothing Then Set rng = Selection
   
    For Each cCell In rng
       
        On Error Resume Next
       
        strValidation = cCell.Validation.Formula1
       
        If Not (Err.Number = 0) Then
            Err.Clear
            Set shp = ActiveSheet.Shapes("Cell_" & Replace(cCell.Address, "$", ""))
            On Error GoTo 0
           
            If shp Is Nothing Then
                Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, cCell.Left, cCell.Top, cCell.Width, cCell.Height)
                shp.Name = "Cell_" & Replace(cCell.Address, "$", "")
                shp.OnAction = "Module1.Button_Test"
                shp.Fill.Transparency = 1
                shp.Line.Visible = msoFalse
                shp.Placement = xlMoveAndSize
            End If
            Set shp = Nothing
        End If
    Next cCell
   
End Sub

Private Sub Count_Shapes()
   
    Dim shp As Shape
   
    For Each shp In ActiveSheet.Shapes
   
        Debug.Print shp.Name
   
    Next shp
   
End Sub
 
Upvote 0
Saee Mane said:
Thank you Jaafar Tribak for the code!

I tried the code in my project and it is exexcuting correctly. The only thing is, the code is running for the specific cell. Where as I want code to be runned for particular range of cells.

Is there any solution for this?
In addition if any cell contains data validation (drop-down) then code should not affect that cell.
Click to expand...
What is the range of cells you want to apply the left click to ?
 
Upvote 0
Ok. I have made a couple of changes to the code so it will now enable the user to toggle the values (TRUE\FALSE) each time they left click a cell within the Range A1:A30 in Sheet1.

Cell A10 is the only cell that has Data Validation in it so, it is skipped.

Workbook example

For the sake of easy use and easy subsequent editing, I have declared two module level constants at the top of the ThisWorkbook Module where you can easily and conveniently set the target Sheet and the Target Range(s) to which you want to apply the cell click event.
VBA Code: 
Private Const TARGET_RANGE = "A1:A30"    '<== change these Consts as needed !
Private Const TARGET_SHEET = "Sheet1"     '<==



The entire code in the ThisWorkbook Module will now look like this:
VBA Code: 
Option Explicit

Private Const TARGET_RANGE = "A1:A30"    '<== change these Consts as needed !
Private Const TARGET_SHEET = "Sheet1"     '<==
   

Private Sub Workbook_Activate()
    EnableCellClickEvent = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    EnableCellClickEvent = False
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

    If EnableCellClickEvent Then
        If Sh Is Sheets(TARGET_SHEET) Then
            If Not Application.Intersect(Target, Range(TARGET_RANGE)) Is Nothing Then
                Cancel = True
            End If
        End If
    End If

End Sub

Private Function HasValidation(ByVal Cell As Range) As Boolean
    Dim lValType As XlDVType
    On Error Resume Next
     lValType = Cell.Validation.Type
    HasValidation = Not CBool(Err.Number)
End Function



'\\===========================
 '\\ Generic OnCellClick Pseudo-Event:
 '\============================

Private Sub OnCellClick(ByVal Target As Range)

    With Target
        If .Parent Is Sheets(TARGET_SHEET) Then
            If Not HasValidation(Target) Then
                If Not Application.Intersect(Target, Range(TARGET_RANGE)) Is Nothing And .Count = 1 Then
                    .HorizontalAlignment = xlCenter
                    .Font.Color = vbRed
                    .Value = IIf(.Text <> "TRUE", "TRUE", "FALSE")
                End If
            End If
        End If
    End With

End Sub
 
Upvote 0
Jaafar Tribak said:
Ok. I have made a couple of changes to the code so it will now enable the user to toggle the values (TRUE\FALSE) each time they left click a cell within the Range A1:A30 in Sheet1.

Cell A10 is the only cell that has Data Validation in it so, it is skipped.

Workbook example

For the sake of easy use and easy subsequent editing, I have declared two module level constants at the top of the ThisWorkbook Module where you can easily and conveniently set the target Sheet and the Target Range(s) to which you want to apply the cell click event.
VBA Code: 
Private Const TARGET_RANGE = "A1:A30"    '<== change these Consts as needed !
Private Const TARGET_SHEET = "Sheet1"     '<==



The entire code in the ThisWorkbook Module will now look like this:
VBA Code: 
Option Explicit

Private Const TARGET_RANGE = "A1:A30"    '<== change these Consts as needed !
Private Const TARGET_SHEET = "Sheet1"     '<==
 

Private Sub Workbook_Activate()
    EnableCellClickEvent = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    EnableCellClickEvent = False
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

    If EnableCellClickEvent Then
        If Sh Is Sheets(TARGET_SHEET) Then
            If Not Application.Intersect(Target, Range(TARGET_RANGE)) Is Nothing Then
                Cancel = True
            End If
        End If
    End If

End Sub

Private Function HasValidation(ByVal Cell As Range) As Boolean
    Dim lValType As XlDVType
    On Error Resume Next
     lValType = Cell.Validation.Type
    HasValidation = Not CBool(Err.Number)
End Function



'\\===========================
 '\\ Generic OnCellClick Pseudo-Event:
 '\============================

Private Sub OnCellClick(ByVal Target As Range)

    With Target
        If .Parent Is Sheets(TARGET_SHEET) Then
            If Not HasValidation(Target) Then
                If Not Application.Intersect(Target, Range(TARGET_RANGE)) Is Nothing And .Count = 1 Then
                    .HorizontalAlignment = xlCenter
                    .Font.Color = vbRed
                    .Value = IIf(.Text <> "TRUE", "TRUE", "FALSE")
                End If
            End If
        End If
    End With

End Sub[/C
[/QUOTE]
Click to expand...

Gokhan Aycan said:
The following code is all there is, and everything is on Module1. Only sheet is Sheet1.

View attachment 46023

VBA Code: 
Option Explicit
'Option Compare Text
'Option Private Module

Public Sub Button_Test()
  
    Dim cCell As Range
  
    Set cCell = Range(Right(Application.Caller, Len(Application.Caller) - Len("Cell_")))
  
    If UCase(cCell.Value) = "TRUE" Then
        cCell.Value = "False"
    Else
        cCell.Value = "True"
    End If
  
    Set cCell = Nothing
  
End Sub

Public Sub Create_Buttons()

    Call Module1.Create_Buttons_From_Range(Selection)

End Sub

Public Sub Create_Buttons_From_Range(Optional ByVal rng As Range)
  
    Dim cCell As Range
    Dim shp As Shape
    Dim strValidation As String
  
    If rng Is Nothing Then Set rng = Selection
  
    For Each cCell In rng
      
        On Error Resume Next
      
        strValidation = cCell.Validation.Formula1
      
        If Not (Err.Number = 0) Then
            Err.Clear
            Set shp = ActiveSheet.Shapes("Cell_" & Replace(cCell.Address, "$", ""))
            On Error GoTo 0
          
            If shp Is Nothing Then
                Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, cCell.Left, cCell.Top, cCell.Width, cCell.Height)
                shp.Name = "Cell_" & Replace(cCell.Address, "$", "")
                shp.OnAction = "Module1.Button_Test"
                shp.Fill.Transparency = 1
                shp.Line.Visible = msoFalse
                shp.Placement = xlMoveAndSize
            End If
            Set shp = Nothing
        End If
    Next cCell
  
End Sub

Private Sub Count_Shapes()
  
    Dim shp As Shape
  
    For Each shp In ActiveSheet.Shapes
  
        Debug.Print shp.Name
  
    Next shp
  
End Sub
Click to expand...
Thank you Gokhan Aycan for the code. I appreciate your efforts!

I tried the code in my project but didn't get any result. I copied the code as is and when clicked on cell didn't get any result.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Q
  • Solved
VBA: Dynamically Create Active X Frame and Yes / No Radio Button
2
Replies
13
Views
285
Domenic
D
K
  • Question Question
Stocktake of Barcoded Inventory in Excel using a Barcode Scanner
Replies
9
Views
359
Kobus Horn
K
P
  • Question Question
Checking for Worksheets that already exist
2
Replies
11
Views
384
Logit
Logit
Artik
  • Solved
Disappearance of the rectangle when the Timer finishes.
Replies
6
Views
577
Artik
Artik
X
  • Question Question
Locking/unlocking a cell with a Combo Box value Mouse click problem
Replies
0
Views
770
XrayLemi
X

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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