vba modifier keys with clicking help

[UMAKEMESIK]

to all,

i have this code that works great.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
' This subroutine colors a cell red when double-clicked then clears it when double-clicked again.
' Some values for .ColorIndex are...
' Red = 3, Green = 4, Blue = 5, Yellow = 6, Orange = 45
' Google "VBA color palette" for more colors
 
    ' If the cell is clear
    If Target.Interior.ColorIndex = xlNone Then
 
        ' Then change the background color to red
        Target.Interior.ColorIndex = 6
 
    ' Else if the cell background color is red
    ElseIf Target.Interior.ColorIndex = 6 Then
 
        ' Then clear the background
        Target.Interior.ColorIndex = xlNone
 
    End If
 
    ' This is to prevent the cell from being edited when double-clicked
    Cancel = True
 
End Sub

on this line
Private Sub Worksheet_BeforeRightClick

my two options are rightclick and double click.

I am looking for a third option if there is one available.

is it possible to add a modifier key like the control key

so it would be something like _BeforeControlClick...

if not , then we will be ok with the 2 options.

thanks in advance.

 

[ZVI]

Hi,

When you are pressing & holding the Ctrl key, double-click event does not occur because in Excel the Ctrl-Click is used for selection in this case.

But you can play with the below code where RightClick/CtrlRightClick changes the cell color in forward/reverse order.
Double-clicking resets the color of the cell.

Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#Else
  Private Declare Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#End If


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  ' Double-clicking resets interior color of the Target cell
  Cancel = True
  Target.Interior.ColorIndex = xlNone
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  ' RightClick/CtrlRightClick changes the cell color in forward/reverse order of array a()
  Dim a() As Variant, i As Integer, c As Long, IsCtrl As Boolean

  ' Define array of the colors
  a = Array(vbWhite, vbGreen, vbYellow, vbRed, vbCyan, vbBlue)

  ' Test if Ctrl key is pressed
  i = GetKeyState(vbKeyControl)
  IsCtrl = i = -127 Or i = -128

  ' Find interior color of the targer cell in a()
  c = Target.Interior.Color
  For i = 0 To UBound(a)
    If c = a(i) Then Exit For
  Next

  ' Exit if color not found in a()
  Cancel = i <= UBound(a)
  If Not Cancel Then Exit Sub

  ' Increase/decrease(if Ctrl) the index 'i' in the colors array a()
  i = i + IIf(IsCtrl, -1, 1)
  If i > UBound(a) Then
    i = 0
  Else
    If i < 0 Then i = UBound(a)
  End If

  ' Set background color
  If i = 0 Then
    Target.Interior.ColorIndex = xlNone
  Else
    Target.Interior.Color = a(i)
  End If

End Sub

 

[UMAKEMESIK]

THANKYOU SO MUCH
worked great

I had to remove

VBA Code:
Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#Else
Private Declare Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#End If

the second private declare function - and the #else. the line was turning read.

this is the code that works

Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer

#End If


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  ' Double-clicking resets interior color of the Target cell
  Cancel = True
  Target.Interior.ColorIndex = xlNone
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  ' RightClick/CtrlRightClick changes the cell color in forward/reverse order of array a()
  Dim a() As Variant, i As Integer, c As Long, IsCtrl As Boolean

  ' Define array of the colors
  a = Array(vbWhite, vbGreen, vbYellow, vbRed, vbCyan, vbBlue)

  ' Test if Ctrl key is pressed
  i = GetKeyState(vbKeyControl)
  IsCtrl = i = -127 Or i = -128

  ' Find interior color of the targer cell in a()
  c = Target.Interior.Color
  For i = 0 To UBound(a)
    If c = a(i) Then Exit For
  Next

  ' Exit if color not found in a()
  Cancel = i <= UBound(a)
  If Not Cancel Then Exit Sub

  ' Increase/decrease(if Ctrl) the index 'i' in the colors array a()
  i = i + IIf(IsCtrl, -1, 1)
  If i > UBound(a) Then
    i = 0
  Else
    If i < 0 Then i = UBound(a)
  End If

  ' Set background color
  If i = 0 Then
    Target.Interior.ColorIndex = xlNone
  Else
    Target.Interior.Color = a(i)
  End If

End Sub

Again - thankyou
this is exactly what i was looking for