none
use date picker to autofilter listbox data RRS feed

  • General discussion

  • Hello there,

    i ask how can i use date picker to autofilter listbox data, i need to use this date picker as a 2 criteria, to determine a duration from day (...) till day (...)

    i have this code

    Private Sub Daily_Click()
    Dim Source As Range, c As Range, i%, Aux As Worksheet
    Dim fa As Range, nc%, ca, v As Range, A As Worksheet, s$
    MthlyDailyIdentifier = "Daily"
    'Dim MthlyDailyIdentifier As String
    Me.ListBox1.ColumnCount = 12
    ListBox1.Clear
    Application.ScreenUpdating = True
    Set A = ThisWorkbook.Sheets("Daily")
    Set Aux = ThisWorkbook.Sheets("popup")     ' auxiliary sheet
    Set Source = A.Range("A1:CB1")
    Set c = A.Range("a1").CurrentRegion
    Source.AutoFilter Field:=1, Criteria1:=Month_list.Value
    Source.AutoFilter Field:=4, Criteria1:=Leader_list.Value
    Source.AutoFilter Field:=6, Criteria1:=User_list.Value
    Set v = c.SpecialCells(xlCellTypeVisible)   ' filtered range
    Aux.Cells.ClearContents
    v.Copy Aux.Range("a1")
    'Set fa = Aux.Range("a1").CurrentRegion
    'nc = fa.Columns.Count
    'ca = Array(3, 13, 14, 15, 16, 17, 21, 30, 31, 32, 33)                     ' columns you want
    'For i = LBound(ca) To UBound(ca)
    '    fa.Columns(ca(i)).Copy Aux.Cells(1, nc + 3 + i) ' create final range
    'Next
     Set fa = Aux.Range("a1").CurrentRegion
        nc = fa.Columns.Count
        ca = Array(3, 13, 14, 15, 16, 17, 21, 20, 30, 31, 32, 33)   ' columns you want
        '' don't need this
    '    For i = LBound(ca) To UBound(ca)
    '        fa.Columns(ca(i)).Copy Aux.Cells(1, nc + 3 + i)    ' create final range
    '    Next
        
        Dim lastRow As Long, j As Long ' put these up top
        ' after copying to Aux, but no need to
        lastRow = Aux.Range("a100000").End(xlUp).Row
        ReDim arr(1 To lastRow, LBound(ca) To UBound(ca))
        For i = LBound(ca) To UBound(ca)
            For j = 1 To lastRow
                arr(j, i) = Aux.Cells(j, ca(i)).Text
            Next
        Next
        Me.ListBox1.List = arr
    'Me.ListBox1.List = Aux.Cells(1, nc + 2 + i).CurrentRegion.Value
    With Me.ListBox1
    Me.ListBox1.BoundColumn = 1
    Me.ListBox1.BorderStyle = fmBorderStyleSingle
    Me.ListBox1.ColumnHeads = True
    Me.ListBox1.BackColor = RGB(255, 255, 255)
    Me.ListBox1.ColumnWidths = "70; 75; 57; 80; 90; 150; 60; 80; 80; 80; 80; 80; 70"
    Me.ListBox1.BorderStyle = 1
    Me.ListBox1.MultiSelect = fmMultiSelectExtended
    End With
    End Sub

    we can build a date picker on field = 3.

    i  ask how to retrieve the auto-filtered data within a specific period as per the date picker selection

    thanks a lot, 

     

    Saturday, March 21, 2015 12:33 PM

All replies

  • Try the following but I am not sure if I am interpreting the question correctly and that this is what you are attempting to do.

    I am assuming that you are using DTPicker to enter the dates. If using textboxes then remember that the dates will be in text format and the text format needs to be handled to convert to a real date and then DateSerial.

    For AutoFilter, the dates need to be converted to a serial number and then concatenate the ">=" and the "<=" with the serial dates.

    Private Sub CommandButton1_Click()
        Dim Source As Range
        Dim dteSerial_1 As Long
        Dim dteSerial_2 As Long
       
        'DTPicker1.Value is first date of range
        dteSerial_1 = DateSerial(Year(DTPicker1.Value), _
                        Month(DTPicker1.Value), Day(DTPicker1.Value))
       
        'DTPicker2.Value is last date of range
        dteSerial_2 = DateSerial(Year(DTPicker2.Value), _
                        Month(DTPicker2.Value), Day(DTPicker2.Value))
       
        'AutoFilter.Range is the generic range object for the Filtered range
        Set Source = Worksheets("Sheet1").AutoFilter.Range
        Source.AutoFilter Field:=3, Criteria1:=">=" & dteSerial_1, _
                            Operator:=xlAnd, Criteria2:="<=" & dteSerial_2


    End Sub


    Regards, OssieMac

    Saturday, March 28, 2015 1:47 AM