Can I Change The Default Size Of Filter Box?

[HaydenJalili]

I use the little filter arrows a lot in excel 2007 and they are cool because of all the extra options and because it lists all your data with a check box so you can select many many variable - it's great - and I know I can change the size of the box all those choices are in by just grabbing the size handle at the bottom right corner and pulling it.

I am CONSTANTLY grabbing that handle and pulling down so I can see more of the filter list in one view - it really helps with scrolling long lists:

Is there a way to change the default size so it is bigger or am I required to grab that little handle all the time? (I'm a keyboard type - speed!)

There must be a VB code object parameter buried in there somewhere that tells the box how big to be when you activate the down arrow? Anyone know how to get to it and can I change the default size of perhaps change it's behavior to autosize or somthing?

Thanks for the help

 

[Peter_SSs]

I don't believe that there is a simple setting/fix. If there is one at all, I suspect @Jaafar Tribak would be the active forum member most likely to know or figure it out. If not, I assume he will at least post to say so.

 

[Jaafar Tribak]

Are you referring to an ActiveX combobox embeeded in a worksheet or in a userform ?

 

[Jaafar Tribak]

@HaydenJalili

If you are still interested, you may want to take a look here:

Adjust the Width of ComboBox Dropdown According to the Widest Entry

This is a common request but It is rather difficult to calculate the exact width of the text on the screen as computing the text size is greatly affected by the font type and the current screen zoom. The following is as accurate and as generic as I could get it (code caters for different fonts...

www.mrexcel.com

 

[MikeGCA]

Are you referring to an ActiveX combobox embeeded in a worksheet or in a userform ?

I'd like an answer also. The issue is the size of the Filter box when a Filter is selected.
After setting AutoFilter for the sheet, select a Filter at the top of a column. A Filter box appears, listing Filter items that can be selected/ deselected. This box is typically too small, and I have to grab the edges to increase its size. Is there a way of setting a larger default size, to avoid having to drag the edges of the box to make it bigger each time?
Also - is it possible to move the default location of that same Filter box? I'd like it to default to a higher place on the screen.

 

[praf007]

I would also like to know how to fix size of filter box as it is too small

 

[Jaafar Tribak]

Sorry for not responding earlier. I was busy.

I never thought the autofilter popup dialog could be resized!

This could be achieved by a windows timer or better by a CBT hook but, as is always the case with subclassing or hooking, if the code is ran from within the VBE, there is a potential risk for crashing the application. I think if the code is ran from a dynamically loaded dll, the code should be stable and won't risk crashing excel even if the VBE Stop\Reset buttons are clicked or if an unhandled error occurs.

If I find the time, I will try to write the code and if it goes well, I willl post it here as this is a good exercise.

 

[Jaafar Tribak]

Here is a code that I put together over the weekend that allows the resizing and relocation on the screen of the AutoFilter Dialog. The code uses a small dll I wrote in TwinBasic. The callback procedure resides in the dll in order to make it IDE safe. The dll Bytes are stored in a hidden worksheet. The effect is application wide but ceasses when the workbook is closed. Ideal to be made into an AddIn ... Tested in x32 and x64 bits.

File Demo:
Excel_AutoFilter_Dialog_Resizer.xlsm







1- API code in a Standard Module:

Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
    Private Const PTR_LEN = 8&
#Else
    Private Const NULL_PTR = 0&
    Private Const PTR_LEN = 4&
#End If
Private Const SIZE = PTR_LEN * 1.5

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
    Private Declare PtrSafe Function VirtualProtect Lib "kernel32.dll" (ByVal lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
    Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As LongPtr, ByVal FuncAddr As LongPtr, ByVal CallConvention As Integer, ByVal rtnType As VbVarType, ByVal FuncArgsCnt As Long, ByRef FuncArgTypes As Any, ByRef FuncArgVarAddresses As Any, ByRef FuncResult As Any) As Long
    Private Declare PtrSafe Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hMod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
    Private Declare Function VirtualProtect Lib "kernel32.dll" (ByVal lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As LongPtr, ByVal FuncAddr As LongPtr, ByVal CallConvention As Integer, ByVal rtnType As VbVarType, ByVal FuncArgsCnt As Long, ByRef FuncArgTypes As Any, ByRef FuncArgVarAddresses As Any, ByRef FuncResult As Any) As Long
    Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hMod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
#End If

Private Type HookX64_DATA
    #If Win64 Then
        OriginBytes(0& To 11&) As Byte
        HookBytes(0& To 11&) As Byte
    #Else
        OriginBytes(0& To 5&) As Byte
        HookBytes(0& To 5&) As Byte
    #End If
    pFunc As LongPtr
    pHooker As LongPtr
    hwnd As LongPtr
End Type

Private uHookData As HookX64_DATA, lHook As LongPtr


Public Sub ResizableAutoFilterDialog( _
    Optional ByVal nLeft As Long = -1&, _
    Optional ByVal nTop As Long = -1&, _
    Optional ByVal nWidth As Long = -1&, _
    Optional ByVal nHeight As Long = -1& _
)
    Dim hLib As LongPtr, hProcAddr As LongPtr
    If Len(Dir(DllFilePathName)) = 0& Then
        If Not BuildDllFile Then MsgBox "Failed to build the dll.": GoTo QH
    End If
    If GetModuleHandle(DllFilePathName) = NULL_PTR Then
        #If Win64 Then
            Call HookX64(Application.hwnd)
        #End If
    End If
    hLib = LoadLibrary(DllFilePathName)
    If hLib Then
        hProcAddr = GetProcAddress(hLib, "ResizeFilter")
        If hProcAddr Then
            Call DllStdCall(hProcAddr, ThisWorkbook, nLeft, nTop, nWidth, nHeight)
        Else
            MsgBox "Failed to run the 'ResizeFilter' dll export function."
        End If
    Else
        MsgBox "Failed to load the dll."
    End If
QH:
End Sub


Public Sub RestoreDefault(Optional ByVal Dummy As Boolean)
    Dim hLib As LongPtr, hProcAddr As LongPtr
    If Len(Dir(DllFilePathName)) Then
        If GetModuleHandle(DllFilePathName) = NULL_PTR Then
            #If Win64 Then
                Call HookX64(Application.hwnd)
            #End If
        End If
        hLib = LoadLibrary(DllFilePathName)
        If hLib Then
            hProcAddr = GetProcAddress(hLib, "RestoreDefault")
            If hProcAddr Then
                Call DllStdCall(hProcAddr)
            Else
                MsgBox "Failed to run the 'RestoreDefault' dll export function."
            End If
        Else
            MsgBox "Failed to load the dll."
        End If
    End If
End Sub


 '____________________________________________ PRIVATE ROUTINES ____________________________________

Private Function DllFilePathName() As String
    #If Win64 Then
        DllFilePathName = Environ("TEMP") & "\" & "XL_AUTOFILTER_RESIZER_x64.DLL"
    #Else
        DllFilePathName = Environ("TEMP") & "\" & "XL_AUTOFILTER_RESIZER_x32.DLL"
    #End If
End Function

Private Function BuildDllFile() As Boolean
    Dim Bytes() As Byte
    Dim Var As Variant, i As Long, FileNum As Integer
    With ThisWorkbook.Worksheets("Dlls_Bytes") '<== VeryHidden sheet containing the dlls bytes.
        #If Win64 Then
            Var = .Range("A2:" & .Range("A1").End(xlDown).Address).Value
        #Else
            Var = .Range("B2:" & .Range("B1").End(xlDown).Address).Value
        #End If
    End With
    ReDim Bytes(LBound(Var) To UBound(Var))
    For i = LBound(Var) To UBound(Var)
        Bytes(i) = CByte(Var(i, 1))
    Next
    FileNum = FreeFile
    Open DllFilePathName For Binary As #FileNum
        Put #FileNum, 1, Bytes
    Close FileNum
    If Len(Dir(DllFilePathName)) Then BuildDllFile = True
End Function

Private Sub HookX64(ByVal hwnd As LongPtr)
    Const WH_CBT = 5&
    Application.OnTime Now + TimeSerial(0, 0, 5), "UnhookX64"
    lHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, NULL_PTR, GetCurrentThreadId)
    Call RedirectSleepAPI(hwnd)
End Sub

Private Sub UnhookX64()
    Call UnhookWindowsHookEx(lHook)
End Sub

Private Function HookProc( _
    ByVal idHook As Long, _
    ByVal wParam As LongPtr, _
    ByVal lParam As LongPtr _
) As LongPtr

    Const HC_ACTION = 0&, HCBT_CREATEWND = 3&
    Dim sBuff As String * 256&, lRet As Long

    If idHook < HC_ACTION Then
        HookProc = CallNextHookEx(lHook, idHook, wParam, lParam)
        Exit Function
    End If
    If idHook = HCBT_CREATEWND Then
        lRet = GetClassName(wParam, sBuff, 256&)
        If UCase(Left(sBuff, lRet)) = "STATIC" Then
            Call UnhookWindowsHookEx(lHook)
            HookProc = -1
        End If
    End If
 
End Function

Private Sub RedirectSleepAPI(ByVal hwnd As LongPtr)
    Const PAGE_EXECUTE_READWRITE = &H40&
    Dim hMod  As LongPtr, OriginProtect As Long, i As Long
 
    With uHookData
        .hwnd = hwnd
        hMod = GetModuleHandle("kernel32.dll")
        .pFunc = GetProcAddress(hMod, "Sleep")
        Call SetProp(hwnd, "FuncPtr", .pFunc)
        If VirtualProtect(ByVal .pFunc, SIZE, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0& Then
            Call CopyMemory(ByVal VarPtr(.OriginBytes(0&)), ByVal .pFunc, SIZE)
            For i = LBound(.OriginBytes) To UBound(.OriginBytes)
                Call SetProp(hwnd, "OrignPtr" & i, .OriginBytes(i))
            Next i
            .pHooker = Choose(1&, AddressOf Redirect)
            #If Win64 Then
                .HookBytes(0&) = &H48
                .HookBytes(1&) = &HB8
                Call CopyMemory(.HookBytes(2&), .pHooker, PTR_LEN)
                .HookBytes(10&) = &HFF
                .HookBytes(11&) = &HE0
            #Else
                .HookBytes(0&) = &H68
                Call CopyMemory(.HookBytes(1&), .pHooker, PTR_LEN)
                .HookBytes(5&) = &HC3
            #End If
            Call CopyMemory(ByVal .pFunc, ByVal VarPtr(.HookBytes(0&)), SIZE)
            Call VirtualProtect(ByVal .pFunc, SIZE, OriginProtect, 0&)
        End If
    End With
End Sub

Private Sub RestoreSleepAPI(ByVal hwnd As LongPtr)
    Const PAGE_EXECUTE_READWRITE = &H40&
    Dim OriginProtect As Long

    #If Win64 Then
        Const UPPER_BOUND = 11&
        Dim Bytes(0& To UPPER_BOUND) As Byte
    #Else
        Const UPPER_BOUND = 5&
        Dim Bytes(0& To UPPER_BOUND) As Byte
    #End If
    Dim i As Long
           If GetProp(hwnd, "FuncPtr") Then
            For i = 0& To UPPER_BOUND
                Bytes(i) = CByte(GetProp(hwnd, "OrignPtr" & i))
            Next i
            Call SetProp(hwnd, "VarPtr", VarPtr(Bytes(0&)))
            If VirtualProtect(ByVal GetProp(hwnd, "FuncPtr"), SIZE, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0& Then
                Call CopyMemory(ByVal GetProp(hwnd, "FuncPtr"), ByVal GetProp(hwnd, "VarPtr"), SIZE)
                VirtualProtect ByVal GetProp(hwnd, "FuncPtr"), SIZE, OriginProtect, 0&
            End If
            Call RemoveProp(hwnd, "FuncPtr")
            Call RemoveProp(hwnd, "OrignPtr")
            Call RemoveProp(hwnd, "VarPtr")
        End If
End Sub

Private Sub Redirect(ByVal dwMilliseconds As Long)
    On Error GoTo ErrHandler
    Call RestoreSleepAPI(uHookData.hwnd)
    Exit Sub
ErrHandler:
    MsgBox "Error: " & Err.Number & vbNewLine & Err.Description
End Sub

Private Function DllStdCall( _
    pAddr As LongPtr, _
    ParamArray FunctionParameters() As Variant _
) As Variant

    Const CC_STDCALL = 4&
    Dim vParamPtr() As LongPtr
 
    Dim pIndex As Long, pCount As Long
    Dim vParamType() As Integer
    Dim vRtn As Variant, vParams() As Variant

    vParams() = FunctionParameters()
    pCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
    If pCount = 0& Then
        ReDim vParamPtr(0& To 0&)
        ReDim vParamType(0& To 0&)
    Else
        ReDim vParamPtr(0 To pCount - 1&)
        ReDim vParamType(0 To pCount - 1&)
        For pIndex = 0& To pCount - 1&
            vParamPtr(pIndex) = VarPtr(vParams(pIndex))
            vParamType(pIndex) = VarType(vParams(pIndex))
        Next
    End If
 
    pIndex = DispCallFunc(ByVal 0&, pAddr, CC_STDCALL, vbEmpty, pCount, vParamType(0&), vParamPtr(0&), vRtn)
    If pIndex = 0& Then
        DllStdCall = vRtn
    Else
        SetLastError pIndex
    End If

End Function

2- Code Usage Example in a Standard Module (As per the File Demo):

Option Explicit

Sub Resize()
'\\ Named Ranges Used:
    '_Left = Range("F2")
    '_Top = Range("F3")
    '_Width = Range("H2")
    '_Height = Range("H3")
    If IsEmpty([_Left]) Then [_Left] = -1&
    If IsEmpty([_Top]) Then [_Top] = -1&
    ResizableAutoFilterDialog _
        nLeft:=[_Left], _
        nTop:=[_Top], _
        nWidth:=[_Width], _
        nHeight:=[_Height]
End Sub

Sub Auto_Close()
    '\\ Restore the Autofilter default size before closing the workbook.
    Call RestoreDefault
    Union([_Left], [_Top], [_Width], [_Height]).ClearContents
End Sub