MouseWheel to Scroll long Cell Validation DopDown Lists ?

[Jaafar Tribak]

Is there a way ,which i am missing, of scrolling a long validation dropdown list with the mouse wheel ?

I am thinking of setting a mouse hook for this (which i guess will be rather involved) but wonder if there is a simpler workround .

Regards.

 

[Jaafar Tribak]

Final update - Hopefully bug-free ,stable and working for all Data Validation lists throughout the workbook.

Workbook Example

1: Code in the Thisworkbook module :

Option Explicit

Private Sub Workbook_Open()
    Call HookValidationList(ActiveCell)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call RemoveHook
End Sub

Private Sub Workbook_Activate()
    Call HookValidationList(ActiveCell)
End Sub
'
Private Sub Workbook_Deactivate()
    Call RemoveHook
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call HookValidationList(ActiveCell)
End Sub

Private Sub Workbook_SheetSelectionChange _
(ByVal Sh As Object, ByVal Target As Range)
    Call HookValidationList(Target)
End Sub

2: Code in a Normal module :

Option Explicit
 
Private Type POINTAPI
  x As Long
  y As Long
End Type
 
Private Type MSLLHOOKSTRUCT
    pt As POINTAPI
    mouseData As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
 
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare Function IsWindow Lib "user32" _
(ByVal hwnd As Long) As Long
  
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
 
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
 
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
 
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
 
Private Declare Function WindowFromPoint Lib "user32" _
(ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
 
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long

Private Declare Function SetProp Lib "user32" Alias "SetPropA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal hData As Long) As Long

Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long

Private Declare Function GetProp Lib "user32" Alias "GetPropA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
 
Private Const WH_MOUSE_LL                 As Long = 14
Private Const WM_MOUSEWHEEL               As Long = &H20A
Private Const HC_ACTION                   As Long = 0
Private Const GWL_HINSTANCE               As Long = (-6)
 
Private lMouseHook                        As Long
Private lAppHwnd                          As Long
Private lDeskHwnd                         As Long
Private lWkbHwnd                          As Long
Private lDropDownHwnd                     As Long


Public Sub HookValidationList(Cell As Range)
    
    Call RemoveHook
    If HasValidateList(Cell) Then
        lAppHwnd = _
        FindWindow("XLMAIN", Application.Caption)
        lDeskHwnd = FindWindowEx _
        (lAppHwnd, 0, "XLDESK", vbNullString)
        lWkbHwnd = FindWindowEx _
        (lDeskHwnd, 0, "EXCEL7", vbNullString)
        SetTimer Application.hwnd, 0, 100, AddressOf TimerProc
    Else
        Call RemoveHook
    End If
 
End Sub

Public Sub RemoveHook()

    KillTimer Application.hwnd, 0
    UnhookWindowsHookEx GetProp(Application.hwnd, "MouseHook")
    RemoveProp Application.hwnd, "MouseHook"

End Sub


Private Sub TimerProc()

    lDropDownHwnd = FindWindow("EXCEL:", vbNullString)
    If lDropDownHwnd <> 0 Then
        Call RemoveHook
        lMouseHook = SetWindowsHookEx _
        (WH_MOUSE_LL, AddressOf LowLevelMouseProc, GetAppInstance, 0)
        SetProp Application.hwnd, "MouseHook", lMouseHook
    End If

End Sub


Private Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, _
ByRef lParam As MSLLHOOKSTRUCT) As Long
 
    If (nCode = HC_ACTION) Then
        If wParam = WM_MOUSEWHEEL Then
            LowLevelMouseProc = True
            If lParam.mouseData > 0 Then
                SendKeys "{UP}"
            Else
                SendKeys "{DOWN}"
            End If
            Exit Function
        End If
        With lParam.pt
            If WindowFromPoint(.x, .y) <> lDropDownHwnd _
            And WindowFromPoint(.x, .y) <> lWkbHwnd Then
                ShowWindow lDropDownHwnd, 0
            End If
        End With
    End If
    
    If IsWindow(lDropDownHwnd) Then Call HookValidationList(ActiveCell)
    
    LowLevelMouseProc = _
    CallNextHookEx(GetProp(Application.hwnd, "MouseHook"), nCode, wParam, ByVal lParam)
 
End Function
 
Private Function GetAppInstance() As Long
 
    GetAppInstance = GetWindowLong(lAppHwnd, GWL_HINSTANCE)
 
End Function

Private Function HasValidateList(Cell As Range) As Boolean
 
    On Error Resume Next
    HasValidateList = Cell.Validation.InCellDropdown
 
End Function

 

[DrewPA]

Jaafar, thank you so much, everything is working perfectly! It no longer has problems when other workbooks are opened or any problems upon closing. This is exactly what I have been needing, thank you very much for your time I really appreciate it!

 

[DrewPA]

Thanks again for helping with this macro, I have been using the workbook and its been working great, save for a small bug. It took me a bit to figure out what was going on, but the drop-down scroll using mousewheel function only works when the "Num Lock" button is not engaged. I was wondering if you knew an easy solution to this or why this would be occurring, as I do use the number pad quite a bit when I am entering data. If it helps I can post my workbook to dropbox or something when I leave work, I am unable to do that on my work computer. Thank you so much!

 

[Jaafar Tribak]

Thanks again for helping with this macro, I have been using the workbook and its been working great, save for a small bug. It took me a bit to figure out what was going on, but the drop-down scroll using mousewheel function only works when the "Num Lock" button is not engaged. I was wondering if you knew an easy solution to this or why this would be occurring, as I do use the number pad quite a bit when I am entering data. If it helps I can post my workbook to dropbox or something when I leave work, I am unable to do that on my work computer. Thank you so much!

I saw that but just ignored it ... Let me see if that can be solved

 

[Richie87]

Hello,

I used this code and work like magic (Office 2010 32bit, Win7). However, my colleague who has also Win 7, but Office 2010 64Bit experiences the error as you can see in the attached picture. Is there any way to fix the code so that it works in both 32Bit and 64Bit version of Excel 2010?

thank you

 

[Jaafar Tribak]

Hi Richie87,
I am afraid I don't have windows 64bit so I can't update/test the code myself .. Hopefully, someone else here will volunteer to do it

 

[kb9zzo]

Each time I click on a cell, I get an error message trying to call the Worksheet_SelectionChange sub saying that the argument is not optional. I'm using Excel 2013 on Win 7. What do I need to change?

 

[My Aswer Is This]

Right click on the sheet tab select "View Code"and delete the script you see there. Or if you want to keep the script show it to us and we can see what may be wrong.

 

[kb9zzo]

It is the code that I copied from post #7, bullet point #2.

And I have actually just fixed it as I noticed that the procedure was getting called from some other places using the ActiveCell argument. I tried it and it worked. So here is my now working code for the worksheet that has the DV:

Private Sub Worksheet_Activate()

    Call HookValidationList(ActiveCell)


End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Call HookValidationList(ActiveCell)
 
End Sub

 

[My Aswer Is This]

Glad I was able to help you. Come back here to Mr. Excel next time you need additional assistance.

It is the code that I copied from post #7, bullet point #2.

And I have actually just fixed it as I noticed that the procedure was getting called from some other places using the ActiveCell argument. I tried it and it worked. So here is my now working code for the worksheet that has the DV:

Private Sub Worksheet_Activate()

    Call HookValidationList(ActiveCell)


End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Call HookValidationList(ActiveCell)
 
End Sub