Would Like to Handle BeforeDoubleClick Event Or SelectionChange Event. But Not Both.

C

CurtisD

New Member
Joined
Oct 4, 2019
Messages
15
The user of a worksheet wants a certain functionality. If the user clicks a cell the font for the cell should be changed to bold. But if the user double clicks a cell he/she wants the fill color to change to red and does not want to change the font. I don't see how this can be done. Because when the user double clicks a cell the SelectionChange event sub executes first. And if it can't detect that the event was a double click it won't know to simply exit the SelectionChange event sub and allow the BeforeDoubleClick event sub to begin.

But perhaps there is a way to detect that a double click event occurred when the SelectionChange event sub begins. Does anyone know? Any suggestions on solving this would be appreciated.
 
Sort by date Sort by votes
Here is the update which now doesn't rely on the Worksheet_SelectionChange event and thus, overcoming the issue caused by keyboard cell selection.

Workbook example

Code in the ThisWorkbook Module:
VBA Code: 
Option Explicit

Private Enum MouseAction
    Click
    DoubleClick
End Enum

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
    #If Win64 Then
        Private Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongLong
    #Else
        Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
    #End If
    Private Declare PtrSafe Function GetDoubleClickTime Lib "user32" () As Long
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    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 GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#Else
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    Private Declare Function GetDoubleClickTime Lib "user32" () As Long
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    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 GetActiveWindow Lib "user32" () As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#End If

Private bDblClicked As Boolean
Private oPrev As Range
Private WithEvents CmBarsEvents As CommandBars

Private Const TARGET_SHEET_NAME = "Sheet1" '<== change target sheet name as needed.
  
  
  
Private Sub Workbook_Activate()
    Call HookCommandBars
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = TARGET_SHEET_NAME Then
        Call HookCommandBars
    End If
End Sub

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

    If Sh.Name = TARGET_SHEET_NAME Then
        Cancel = True
        bDblClicked = True
        If Not oPrev Is Nothing Then
            If oPrev.Address = Target.Address Then
                bDblClicked = False
            End If
        End If
        Call MyMacro(Target, DoubleClick)
        Call SetKeyState(vbKeyLButton)
    End If

End Sub
  
Private Sub CmBarsEvents_OnUpdate()

    Const FRACTION = 4 '<== change this const value if needed. (experiment with 1 to 6)
    
    #If Win64 Then
        Dim t As LongLong
    #Else
        Dim t As Long
    #End If
    
    Dim tCurPos As POINTAPI
    
    If GetActiveWindow = Application.hwnd Then
        If ActiveSheet.Name = TARGET_SHEET_NAME Then
            Call GetCursorPos(tCurPos)
            If TypeName(ActiveWindow.RangeFromPoint(tCurPos.X, tCurPos.Y)) = "Range" Then
                t = GetTickCount
                Do: DoEvents
                Loop While GetTickCount - t <= GetDoubleClickTime / FRACTION
                If bDblClicked = False Then
                    On Error Resume Next
                    If ActiveWindow.RangeSelection.Count = 1 Then
                        If Err.Number = 0 Then
                            On Error GoTo 0
                            If GetKeyState(vbKeyLButton) Then
                                Call MyMacro(ActiveCell, Click)
                            End If
                        End If
                    End If
                Else
                    bDblClicked = False
                End If
                Call SetKeyState(vbKeyLButton)
                bDblClicked = False
                Set oPrev = ActiveCell
            End If
        End If
    End If

End Sub

Private Sub HookCommandBars()
    If CmBarsEvents Is Nothing Then
        Set CmBarsEvents = Application.CommandBars
        Call CmBarsEvents_OnUpdate
    End If
End Sub

Private Sub SetKeyState(ByVal Key As Long)
    Dim kbArray As KeyboardBytes
    
    Call GetKeyState(Key)
    Call GetKeyboardState(kbArray)
    kbArray.kbByte(Key) = 0
    Call SetKeyboardState(kbArray)
End Sub

Private Sub MyMacro(ByVal Target As Range, ByVal Action As MouseAction)
    If Action = Click Then
        Target = "Clicked"
        Debug.Print "Cell Clicked: ", Target.Address
    Else
        Target = "Dbl-Clicked"
        Debug.Print "Cell Double-Clicked: ", Target.Address
    End If
End Sub
 
Upvote 0

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Jaafar Tribak said:
Thanks for the feedback.

There is however one serious issue with the code which I didn't think about: the Click code also fires when selecting cells with keyboard navigation keys (arrow, Home, pageUpDown keys etc).

This Shouldn't happen as the Click code should fire only when carrying out a mouse click on the cell.

The Worksheet_SelectionChange event doesn't distiguish between a mouse click and a selection with keyboard keys. So I have taken a slightly different approach which I will be posting in the next post.
Click to expand...
Thanks for letting me know. I hadn't thought of that. I appreciate your help!
 
Upvote 0
Jaafar Tribak said:
Here is the update which now doesn't rely on the Worksheet_SelectionChange event and thus, overcoming the issue caused by keyboard cell selection.

Workbook example

Code in the ThisWorkbook Module:
VBA Code: 
Option Explicit

Private Enum MouseAction
    Click
    DoubleClick
End Enum

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
    #If Win64 Then
        Private Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongLong
    #Else
        Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
    #End If
    Private Declare PtrSafe Function GetDoubleClickTime Lib "user32" () As Long
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    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 GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#Else
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    Private Declare Function GetDoubleClickTime Lib "user32" () As Long
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    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 GetActiveWindow Lib "user32" () As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#End If

Private bDblClicked As Boolean
Private oPrev As Range
Private WithEvents CmBarsEvents As CommandBars

Private Const TARGET_SHEET_NAME = "Sheet1" '<== change target sheet name as needed.
 
 
 
Private Sub Workbook_Activate()
    Call HookCommandBars
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = TARGET_SHEET_NAME Then
        Call HookCommandBars
    End If
End Sub

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

    If Sh.Name = TARGET_SHEET_NAME Then
        Cancel = True
        bDblClicked = True
        If Not oPrev Is Nothing Then
            If oPrev.Address = Target.Address Then
                bDblClicked = False
            End If
        End If
        Call MyMacro(Target, DoubleClick)
        Call SetKeyState(vbKeyLButton)
    End If

End Sub
 
Private Sub CmBarsEvents_OnUpdate()

    Const FRACTION = 4 '<== change this const value if needed. (experiment with 1 to 6)
   
    #If Win64 Then
        Dim t As LongLong
    #Else
        Dim t As Long
    #End If
   
    Dim tCurPos As POINTAPI
   
    If GetActiveWindow = Application.hwnd Then
        If ActiveSheet.Name = TARGET_SHEET_NAME Then
            Call GetCursorPos(tCurPos)
            If TypeName(ActiveWindow.RangeFromPoint(tCurPos.X, tCurPos.Y)) = "Range" Then
                t = GetTickCount
                Do: DoEvents
                Loop While GetTickCount - t <= GetDoubleClickTime / FRACTION
                If bDblClicked = False Then
                    On Error Resume Next
                    If ActiveWindow.RangeSelection.Count = 1 Then
                        If Err.Number = 0 Then
                            On Error GoTo 0
                            If GetKeyState(vbKeyLButton) Then
                                Call MyMacro(ActiveCell, Click)
                            End If
                        End If
                    End If
                Else
                    bDblClicked = False
                End If
                Call SetKeyState(vbKeyLButton)
                bDblClicked = False
                Set oPrev = ActiveCell
            End If
        End If
    End If

End Sub

Private Sub HookCommandBars()
    If CmBarsEvents Is Nothing Then
        Set CmBarsEvents = Application.CommandBars
        Call CmBarsEvents_OnUpdate
    End If
End Sub

Private Sub SetKeyState(ByVal Key As Long)
    Dim kbArray As KeyboardBytes
   
    Call GetKeyState(Key)
    Call GetKeyboardState(kbArray)
    kbArray.kbByte(Key) = 0
    Call SetKeyboardState(kbArray)
End Sub

Private Sub MyMacro(ByVal Target As Range, ByVal Action As MouseAction)
    If Action = Click Then
        Target = "Clicked"
        Debug.Print "Cell Clicked: ", Target.Address
    Else
        Target = "Dbl-Clicked"
        Debug.Print "Cell Double-Clicked: ", Target.Address
    End If
End Sub
Click to expand...
Thank you so much. I really appreciate your efforts. Sincerely, Curtis
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Checking for Worksheets that already exist
2
Replies
11
Views
138
Logit
Logit
N
  • Solved
VBA Question
Replies
3
Views
399
RoryA
RoryA
B
  • Solved
Event code to give message box and change color of auto-shape
Replies
4
Views
729
bh24524
B
A
  • Question Question
VBA for setting up the printing pages per sheet
Replies
0
Views
494
Aurum1
A
Jaafar Tribak
  • Question Question
KeyPress Event for Worksheet Cells (Subclassing Without Crashing)
Replies
0
Views
253
Jaafar Tribak
Jaafar Tribak

Forum statistics

Threads
1,223,894
Messages
6,175,252
Members
452,623
Latest member
Techenthusiast

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