Keydown Keycode not working for mouse click

[XrayLemi]

I thought I was getting better at this but again I am stumped.

I had posted something nearly Identical to this recently. I didn't get a reply, I even thought I had found an answer. However, This is only partly true.
Here is the link to my original post. Unlock a cell with a ComboBox entry

The latest code is slightly different than the original post. It now works without using data validation. Neither the code in the original post,
or the code in this post will work with a mouse click.

This code "works" with a ComboBox in column G. The cell it reacts with is in Column H.

When it comes to this code.....

Private Sub MDList_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
         
    Select Case KeyCode
        Case 9 'Tab
           If MDList.Value <> "Not Listed" Then
             ActiveCell.Offset(0, 1).ClearContents
             ActiveCell.Offset(0, 1).Locked = True
            Else
             'If MDList.Value = "Not Listed" Then
             ActiveCell.Offset(0, 1).Locked = False
           End If
             ActiveCell.Offset(0, 1).Activate
             MDList.Visible = False
     End Select
End Sub

All cases work perfectly on the Keyboard. Tab works, Enter works, Left and right arrows work. When it comes to using the mouse.

Case 1 'Left Mouse click
           If MDList.Value <> "Not Listed" Then
             ActiveCell.Offset(0, 1).ClearContents
             ActiveCell.Offset(0, 1).Locked = True
            Else
             'If MDList.Value = "Not Listed" Then
             ActiveCell.Offset(0, 1).Locked = False
           End If
             ActiveCell.Offset(0, 1).Activate
             MDList.Visible = False
     End Select

This does not work. I even tried a separate sub using KeyUp for the mouse click. No Luck.
I cannot figure this out. I hope the folks here can.
Thank you in advance,
Jim

 

[Jaafar Tribak]

You are not giving any context.
Why use the keydown for trapping mouse clicks... Use the MouseDown event.

 

[XrayLemi]

Hello Jaafar,
Thank you so much for the quick response.

First, I am extremely limited in my VBA skills. Mostly copy, paste, change, and hope. Without the help here I would be completely sunk.

I used KeyDown because the link I found (Key Code Constants) Shows A keycode for left mouse click. These codes are for things like my activex ComboBox. Until now I have never heard of MouseDown. I searched the net for MouseDown and ComboBoxes but found nothing. Does it work with an Activex ComboBox?

As far as context, I have to cover all my bases with the data entry. and the last thing I need to work is mouse click. When a user selects a value from the Box in column G with a mouse click, then clicks on the next cell in column H, I need that cell to be unlocked if the result in column G is "Not Listed". I need it to be locked and blank if the data in G is any other result. I add the "and Blank" statement because if a user changes their mind, I want the entry in column H to be deleted if the result in column G is not "Not Listed"

I am not sure what other context you need. Let me know and I will gladly provide it.

 

[Jaafar Tribak]

You could use the LisBox Click event as follows:

Private Sub ListBox1_Click()
    MsgBox "You clicked :" & ListBox1.Name & vbTab & "Current value := " & ListBox1.Value
End Sub

Or the mouse event as follows:

Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        MsgBox "mouse down"
    End If
End Sub

Codes to be placed in the module of the sheet where the listbox is located.

 

[XrayLemi]

Now I don't have a listbox. It is a combobox. the combobox gets its values from a dynamic range in sheet 1. It is hidden until you click on, or arrow - TAB over the cell. I don't know if that matters.

Here is the entire code for the sheet. Maybe this will help you see what I need.

'Dim for old cell values after a change is made
Dim old

'Select only one cell at a time
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Cells.CountLarge > 1 Then
        MsgBox "Sorry, multiple selections are not allowed.", vbCritical
        ActiveCell.Select
    End If
'Code to get old / new cell value
    If Target.Cells.CountLarge = 1 Then
        If Not Intersect(Target, Range("A1:M1048576, O1:XFD1048576")) Is Nothing Then
          old = Target.Value
        End If
    End If

'ComboBox Code
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Dim nm As Name
Dim wsNm As Worksheet
Dim rng As Range
Set wsList = Sheets("List")

Set ws = ActiveSheet
  On Error GoTo errHandler

If Target.Count > 1 Then GoTo exitHandler

  Set cboTemp = ws.OLEObjects("MDList")
    On Error Resume Next
  If cboTemp.Visible = True Then
    With cboTemp
      .Top = 10
      .Left = 10
      .ListFillRange = ""
      .LinkedCell = ""
      .Visible = False
      .Value = ""
    End With
  End If

  On Error GoTo errHandler
  If Not Intersect(Target, Range("G6:G3000")) Is Nothing Then
    Application.EnableEvents = False
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 30
      .Height = Target.Height + 15
      .ListFillRange = str
      If .ListFillRange <> str Then
        'for dynamic named ranges
        str = Target.Validation.Formula1
        str = Right(str, Len(str) - 1)
        Set wb = ActiveWorkbook
        Set nm = wb.Names(str)
        Set wsNm = wb.Worksheets _
          (nm.RefersToRange.Parent.Name)
        Set rng = wsNm.Range _
          (nm.RefersToRange.Address)
        .ListFillRange = "'" & wsNm.Name _
              & "'!" & rng.Address
      End If
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
  End If
exitHandler:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Exit Sub
errHandler:
  Resume exitHandler
    
End Sub

'Keycode instructions for ComboBox using keyboard.  This works perfectly
Private Sub MDList_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
         
    Select Case KeyCode
        Case 9 'Tab
            If MDList.Value <> "Not Listed" Then
             ActiveCell.Offset(0, 1).ClearContents
             ActiveCell.Offset(0, 1).Locked = True
            Else
             ActiveCell.Offset(0, 1).Locked = False
            End If
             ActiveCell.Offset(0, 1).Activate
             MDList.Visible = False
        Case 37 'Lt Arrow
            If MDList.Value <> "Not Listed" Then
             ActiveCell.Offset(0, 1).ClearContents
             ActiveCell.Offset(0, 1).Locked = True
            Else
             ActiveCell.Offset(0, 1).Locked = False
            End If
             ActiveCell.Offset(0, 1).Activate
             MDList.Visible = False
        Case 39 'Rt Arrow
            If MDList.Value <> "Not Listed" Then
             ActiveCell.Offset(0, 1).ClearContents
             ActiveCell.Offset(0, 1).Locked = True
            Else
             ActiveCell.Offset(0, 1).Locked = False
            End If
             ActiveCell.Offset(0, 1).Activate
             MDList.Visible = False
        Case 13 'Enter
            If MDList.Value <> "Not Listed" Then
             ActiveCell.Offset(0, 1).ClearContents
             ActiveCell.Offset(0, 1).Locked = True
            Else
             ActiveCell.Offset(0, 1).Locked = False
            End If
             ActiveCell.Offset(0, 1).Activate
             MDList.Visible = False
          End Select

End Sub

'Keycode instructions for ComboBox using Mouse
'This and many versions of it didn't work
Private Sub MDList_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
        Case 1 'Left Mouse
            If MDList.Value <> "Not Listed" Then
             ActiveCell.Offset(0, 1).ClearContents
             ActiveCell.Offset(0, 1).Locked = True
            Else
             ActiveCell.Offset(0, 1).Locked = False
            End If
             ActiveCell.Offset(0, 1).Activate
             MDList.Visible = False
    End Select

End Sub

Private Sub CommandButton1_Click()
    UpdateDataFromMasterFile
End Sub

Private Sub CommandButton2_Click()
maint_form.Show
End Sub

'Rules for lock / unlock status of individual cells
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, c As Range
  Set r = Union(Range("I6:I3000"), Range("K6:K3000"))
  Set r = Intersect(Target, r)
  If Not r Is Nothing Then
   Application.EnableEvents = False
   For Each c In r
    Select Case True
      Case 11 = c.Column 'K
        If c.Value = "" Then
          Cells(c.Row, "L").Value = ""
          Cells(c.Row, "L").Locked = True
          Else
          Cells(c.Row, "L").Locked = False
        End If
        Case 9 = c.Column 'I
        If c.Value = "" Then
          Cells(c.Row, "N").Value = ""
          Cells(c.Row, "N").Locked = True
          Else
          Cells(c.Row, "N").Locked = False
        End If
      Case Else
    End Select
  Next c
  End If
 
'Automatically adds the date 
  If Target.Cells.Count > 3 Then Exit Sub
   If Not Intersect(Target, Range("C6:C3000")) Is Nothing Then
    With Target(1, 3)
     .Value = Date
     .EntireColumn.AutoFit
    End With
  End If

'Changes the lock status of each row as necessary
     Dim p As Range, z As Range
     Set p = Range("N6:N2999")
     Set p = Intersect(Target, p)
     If Not p Is Nothing Then
   Application.EnableEvents = False
     For Each z In p
      Select Case True
       Case 14 = z.Column 'N
        If z.Value <> "" Then
         Check = MsgBox("Are your entries correct?" & vbCrLf & "After entering yes, These values CANNOT be changed.", vbYesNo + vbQuestion, "Cell Lock Notification")
            If Check = vbYes Then
             Target.Rows.EntireRow.Locked = True
             Cells(z.Row + 1, "B").Locked = False
             Cells(z.Row + 1, "C").Locked = False
             Cells(z.Row + 1, "D").Locked = False
             Cells(z.Row + 1, "E").Locked = False
             Cells(z.Row + 1, "F").Locked = False
             Cells(z.Row + 1, "G").Locked = False
             Cells(z.Row + 1, "H").Locked = False
             Cells(z.Row + 1, "I").Locked = False
             Cells(z.Row + 1, "J").Locked = False
             Cells(z.Row + 1, "K").Locked = False
             Cells(z.Row + 1, "M").Locked = False
             If Cells(z.Row, "R").Value <> "" Then Copyemail 'R
             If Cells(z.Row, "S").Value <> "" Then ThisWorkbook.Save 'S
             With Me
                .Parent.Activate
                .Activate
                .Range("B" & Rows.Count).End(xlUp).Offset(1).Activate
            End With
            Else
             Cells(z.Row, "N").Value = ""
           End If
          End If
      Case Else
    End Select
   Next z
 End If
 
'Locks the entire sheet after the final entry and switches to the next sheet
 Dim e As Range, Y As Range
    Set e = Range("N3000")
    Set e = Intersect(Target, e)
    If Not e Is Nothing Then
   Application.EnableEvents = False
     For Each Y In e
      Select Case True
       Case 14 = Y.Column 'N
        If Y.Value <> "" Then
         Check = MsgBox("Are your entries correct?" & vbCrLf & "After entering yes, These values CANNOT be changed.", vbYesNo + vbQuestion, "Cell Lock Notification")
           If Check = vbYes Then
             Target.Rows.EntireRow.Locked = True
             Cells(Y.Row + 1, "D").Value = "Book Closed"
             Sheets("Book 1").Range("A1:XFD1048576").Locked = True
             If Cells(Y.Row, "R").Value <> "" Then Copyemail 'R
             If Cells(Y.Row, "S").Value <> "" Then ThisWorkbook.Save 'S
             Sheets("Book 2").Range("B6:G6,I6:K6,M6").Locked = False
             Sheets("Book 2").Select
             Else
             Cells(Y.Row, "N").Value = ""
           End If
        End If
      Case Else
    End Select
   Next Y
 End If
 
'Locks the entire sheet if needed and switches to the next sheet
 If Target.Cells.Count > 1 Then
  End If
    If Not Intersect(Target, Range("D3001")) Is Nothing Then
      If Target.Value <> "" Then
        With Application
          Sheets("Book 1").Range("A1:XFD1048576").Locked = True
          Sheets("Book 2").Range("B6:G6,I6:K6,M6").Locked = False
          Sheets("Book 2").Select
        End With
      End If
 End If

  'Sends me an e-mail when changes are made and records all the changes on sheet 2
  If Target.CountLarge > 1 Then
    End If
    If Not Intersect(Target, Range("B6:M1048576, O6:XFD1048576")) Is Nothing Then
      If Target.Locked = True Then
          With Application
           .EnableEvents = False
            With ThisWorkbook.Worksheets("Sheet2").UsedRange.Rows
            Sheets("Sheet2").Unprotect "Password"
             .Item(.Count + 1).Columns("B").Value = old
             .Item(.Count + 1).Columns("C").Value = Target.Value
             .Item(.Count + 1).Columns("D").Value = Environ("username")
             .Item(.Count + 1).Columns("E").Value = Now
             .Item(.Count + 1).Columns("F").Value = Target.Row
             .Item(.Count + 1).Columns("G").Value = Target.Column
              .Item(.Count + 1).Columns("H").Value = ActiveSheet.Name
            End With
                Application.ScreenUpdating = False
                Dim outlookApp As Object
                Dim myMail As Object
                Set outlookApp = CreateObject("Outlook.Application")
                Set myMail = outlookApp.CreateItem(0)
                myMail.to = "james.lemieux@va.gov"
                myMail.Subject = "Changes made"
                myMail.HTMLBody = "Changes to file " & Application.ActiveWorkbook.FullName & ", " & ActiveSheet.Name & ",    Row " & Target.Row & ",    Column " & Target.Column
                myMail.send
             .EnableEvents = True
          End With
      End If
    End If
       Sheets("Sheet2").Protect "Password"
     Application.EnableEvents = True
End Sub

The combobox appears over the selected cell in column G. the row that has to be unlocked, or locked and cleared, is the corresponding cell in column H. After selection and using TAB, Enter, Right or left arrow, the cells in row H do what they are supposed to. It is only when I choose a value and then click on column H with the mouse That I cannot get it to work.

I hope the full picture helps.

Jim

 

[XrayLemi]

I should also add, I have no problems activating the combobox with a left mouse click. There is no problem selecting a value from the combobox with a mouse click. There is no problem exiting the combobox when I click on the next cell. The combobox disappears after clicking the cell in column H. What does NOT happen is the change of the locked / unlocked status of the cell in column H after a mouse click. Yet, the status changes perfectly with the keycodes on the keyboard.

 

[Jaafar Tribak]

Hi XrayLemi

I am afraid, I couldn't make this work... Perhaps some other forum member may be able to help.

Regards.

 

[XrayLemi]

Okay, Thank you for trying. Should I create a new thread, or leave it and hope someone else responds?

Thanks,
Jim

 

[Akuini]

'Keycode instructions for ComboBox using Mouse
'This and many versions of it didn't work
Private Sub MDList_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Why don't you use ComboBox1_Click() event? or in this case Private Sub MDList_Click()

 

[XrayLemi]

Hi Akuini,
Because my friend, I am a novice in The VBA area. I am not sure how I would use what you are suggesting.
What I am having (I think) is an after issue. I explain my problem in detail in post #6. This is where my problem is.