none
Filter Data with Date range. Dates would be selected in user form calendar ... RRS feed

  • Question

  • Does anybody could help me to create a user form, that user could select the date and time from either calendar or other control button (from Userform control Toolbox) and the VBA code would filter the data on Excel SpreadSheet depending on input...

    I want user to specify start time and the end time, that I would know the period of time which is on interest and filter the data depending on inputs...

    This is part of my table on Sheet1:

    ID                     Time

     

      Products

    ProdNoExit

    8 04-06-2013 23:00 15 1
    8 04-06-2013 23:30 205 1
    8 05-06-2013 00:00 235 1
    8 05-06-2013 00:30 587 1
    8 05-06-2013 01:00 874 1
    8 05-06-2013 01:30 155 1
    8 05-06-2013 02:00 150 1
    8 05-06-2013 02:30 258 1
    Friday, December 19, 2014 10:30 AM

Answers

  • Try this.

    Sub ApplyFilter()
    Dim wsDL As Worksheet
    Dim wsO As Worksheet
    Dim rngAD As Range
    Set wsDL = Sheets("DateList")
    Set wsO = Sheets("Orders")
    Set rngAD = wsO.Range("AllDates")
    'update the list of dates
      wsDL.Range("A1").CurrentRegion.ClearContents
      'rngAD.Offset(-1, 0).Resize(rngAD.Rows.Count + 1).Select
      rngAD.AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", _
        CopyToRange:=wsDL.Range("A1"), Unique:=True
      wsDL.Range("A1").CurrentRegion.Sort _
          Key1:=wsDL.Range("A2"), Order1:=xlAscending, header:=xlYes
    'filter the list
    wsO.Range("Database").AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=wsO.Range("G1:H2"), Unique:=False
    End Sub
    
    Sub RemoveFilter()
    On Error Resume Next
        ActiveSheet.ShowAllData
    End Sub
    

    My setup looks like this.


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    • Marked as answer by GyTasS Monday, December 22, 2014 6:05 AM
    Friday, December 19, 2014 4:19 PM
  • Please try this.

    Option Explicit
    
    Sub ApplyFilter()
    Dim wsDL As Worksheet
    Dim wsO As Worksheet
    Dim rngAD As Range
    Set wsDL = Sheets("DateList")
    Set wsO = Sheets("Orders")
    Set rngAD = wsO.Range("AllDates")
    'update the list of dates
      wsDL.Range("A1").CurrentRegion.ClearContents
      'rngAD.Offset(-1, 0).Resize(rngAD.Rows.Count + 1).Select
      rngAD.AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", _
        CopyToRange:=wsDL.Range("A1"), Unique:=True
      wsDL.Range("A1").CurrentRegion.Sort _
          Key1:=wsDL.Range("A2"), Order1:=xlAscending, header:=xlYes
    'filter the list
    wsO.Range("Database").AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=wsO.Range("G1:H2"), Unique:=False
    End Sub
    
    Sub RemoveFilter()
    On Error Resume Next
        ActiveSheet.ShowAllData
    End Sub
    
    
    

    My setup looks like this.


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.


    • Edited by ryguy72 Friday, December 19, 2014 4:20 PM
    • Marked as answer by GyTasS Monday, December 22, 2014 6:05 AM
    Friday, December 19, 2014 4:19 PM

All replies


  • This question also posted in the Excel for Developers forum.
    '---
    Jim Cone
    free excel Date Picker add-in (na xl2013)
    (free & commercial excel add-ins & workbooks)

    • Edited by James Cone Thursday, October 20, 2016 3:17 PM
    Friday, December 19, 2014 2:44 PM
  • Try this.

    Sub ApplyFilter()
    Dim wsDL As Worksheet
    Dim wsO As Worksheet
    Dim rngAD As Range
    Set wsDL = Sheets("DateList")
    Set wsO = Sheets("Orders")
    Set rngAD = wsO.Range("AllDates")
    'update the list of dates
      wsDL.Range("A1").CurrentRegion.ClearContents
      'rngAD.Offset(-1, 0).Resize(rngAD.Rows.Count + 1).Select
      rngAD.AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", _
        CopyToRange:=wsDL.Range("A1"), Unique:=True
      wsDL.Range("A1").CurrentRegion.Sort _
          Key1:=wsDL.Range("A2"), Order1:=xlAscending, header:=xlYes
    'filter the list
    wsO.Range("Database").AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=wsO.Range("G1:H2"), Unique:=False
    End Sub
    
    Sub RemoveFilter()
    On Error Resume Next
        ActiveSheet.ShowAllData
    End Sub
    

    My setup looks like this.


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    • Marked as answer by GyTasS Monday, December 22, 2014 6:05 AM
    Friday, December 19, 2014 4:19 PM
  • Please try this.

    Option Explicit
    
    Sub ApplyFilter()
    Dim wsDL As Worksheet
    Dim wsO As Worksheet
    Dim rngAD As Range
    Set wsDL = Sheets("DateList")
    Set wsO = Sheets("Orders")
    Set rngAD = wsO.Range("AllDates")
    'update the list of dates
      wsDL.Range("A1").CurrentRegion.ClearContents
      'rngAD.Offset(-1, 0).Resize(rngAD.Rows.Count + 1).Select
      rngAD.AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", _
        CopyToRange:=wsDL.Range("A1"), Unique:=True
      wsDL.Range("A1").CurrentRegion.Sort _
          Key1:=wsDL.Range("A2"), Order1:=xlAscending, header:=xlYes
    'filter the list
    wsO.Range("Database").AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=wsO.Range("G1:H2"), Unique:=False
    End Sub
    
    Sub RemoveFilter()
    On Error Resume Next
        ActiveSheet.ShowAllData
    End Sub
    
    
    

    My setup looks like this.


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.


    • Edited by ryguy72 Friday, December 19, 2014 4:20 PM
    • Marked as answer by GyTasS Monday, December 22, 2014 6:05 AM
    Friday, December 19, 2014 4:19 PM