Autofilter by a certain Date Range?

[Chronix99]

Hello,

I have a table of data which has a date column with dates in a very strict format (dd/mm/yyyy).

I have a userform with a bit of VBA script behind it to prompt a user for a "START" date and a "END" date. I need to filter my table to show only the entries between these two dates, copy it into a new worksheet and then show it.

I've got all the code together but the filter won't work, it just shows every record.

This is what I have so far:

'Declare variables
Dim dtmFrom As Date
Dim dtmTo As Date
Dim intRCount As Integer

'Check if date inpts are valid and then assign user inputs to variables
If IsDate(FromDate1) Then
dtmFrom = DateSerial(Year(FromDate1), Month(FromDate1), Day(FromDate1))
Else: dtmFrom = MsgBox("Please enter a valid ""FROM"" date.", vbCritical + vbOKOnly)
Exit Sub
End If

If IsDate(ToDate1) Then
dtmTo = DateSerial(Year(ToDate1), Month(ToDate1), Day(ToDate1))
Else: dtmFrom = MsgBox("Please enter a valid ""TO"" date.", vbCritical + vbOKOnly)
Exit Sub
End If

If ToDate1.Value < FromDate1.Value Then
dtmFrom = MsgBox("Please ensure the TO Date is after the FROM Date.")
Exit Sub
Else: End If

'Create a new Summary Worksheet
Worksheets.Add(After:=Worksheets(4)).Name = "SummaryWorksheet"
'Populate Orders Summary
Sheets("Orders").Select
intRCount = ActiveSheet.UsedRange.Rows.Count

'Auto Filter table for viewing
Range("$A$1:$F$" & intRCount).AutoFilter
ActiveSheet.Range("$A$1:$F$" & intRCount).AutoFilter Field:=1, Criteria1:=">=" & dtmFrom, Operator:=xlAnd, Criteria2:="<=" & dtmTo
Range("$A$2:$F$" & intRCount).Select
Selection.Copy
Sheets("SummaryWorksheet").Select
Range("A9").Select
ActiveSheet.Paste
Sheets("Orders").Select
Application.CutCopyMode = False

Now I wasn't sure how to do this initially, so I used the 'record macro' and got the basic structure off it and made a few modifications... any help?

 

[Chronix99]

Yup, it gets dumped into cells perfectly when I try that method.

Two columns, with column headers saying "Date" and then under each header there are the two inputted dates formated as ">=date1" and "<=date2"

 

[Datsmart]

Played with your code and added some Advanced Filter steps.

Private Sub CommandButton2_Click()
'Declare variables
Dim dtmFrom As Date
Dim dtmTo As Date
Dim intRCount As Integer

'Assign variables for Data, Criteria, and Target WorkSheet names
    DSheet = "Orders"
    CSheet = "CriteriaWorksheet"
    TSheet = "SummaryWorksheet"

'Assign variables for From and To Dates since this code does not use a UserForm to create them
    FromDate1 = "10/06/2011"
    ToDate1 = "10/14/2011"

'Check if date inpts are valid and then assign user inputs to variables
    If IsDate(FromDate1) Then
        dtmFrom = DateSerial(Year(FromDate1), Month(FromDate1), Day(FromDate1))
    Else
        dtmFrom = MsgBox("Please enter a valid ""FROM"" date.", vbCritical + vbOKOnly)
        Exit Sub
    End If

    If IsDate(ToDate1) Then
        dtmTo = DateSerial(Year(ToDate1), Month(ToDate1), Day(ToDate1))
    Else
        dtmFrom = MsgBox("Please enter a valid ""TO"" date.", vbCritical + vbOKOnly)
        Exit Sub
    End If

'If ToDate1.Value < FromDate1.Value Then
    If ToDate1 < FromDate1 Then
        dtmFrom = MsgBox("Please ensure the TO Date is after the FROM Date.")
        Exit Sub
    End If

'Remove Old Summary WorkSheet if it exists (without Prompt)
'==================================
    If Worksheets(TSheet).Name = TSheet Then
        Application.DisplayAlerts = False
        Sheets(TSheet).Delete
        Application.DisplayAlerts = True
    End If
'==================================

'Create a new Summary Worksheet
'==================================
    On Error Resume Next
    If Worksheets(TSheet).Name = "" Then
       Sheets.Add(After:=Worksheets(4)).Name = TSheet
    End If
    
'Format Worksheet to look nice
Sheets("SummaryWorksheet").Select
'Range("A1:G2").Select
    With Range("A1:G2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
Range("A1:G2").Merge
    With Range("A1:G2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Range("A1:G2").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
Sheets("SummaryWorksheet").Select
    Range("A1:F2").Value = "Summary Report - " & dtmFrom & " to " & dtmTo
    Range("A1:F2").Font.Size = 18
    Range("A1:F2").Font.Bold = True
    Range("A3:F3").Merge
    Range("A3:F3").Value = "Total Number of Sales:"
    Range("A4:F4").Merge
    Range("A4:F4").Value = "Total Income from Sales:"
    Range("A5:F5").Merge
    Range("A5:F5").Value = "Total raised for ""ENVIRONMENT"":"
    Range("A6:G6").Merge
    Range("A6:G6").Value = "Report Created on: " & Date
    Range("A8").Value = "Orders Summary"

    With Range("A8:G8")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
Range("A8:G8").Merge
    With Range("A8:G8").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    With Range("A8:G8").Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Range("A8:G8").Font.Bold = True

'Create Criteria WorkSheet
'This Sheet is used by Advanced Filter to setup the Date criteria
'After it is used this Sheet is Deleted
'==================================
    On Error Resume Next
    If Worksheets(CSheet).Name = "" Then
       Sheets.Add.Name = CSheet
       'Assign Criteria Data to cells
        Sheets(CSheet).Range("A1").Value = "Date"
        Sheets(CSheet).Range("B1").Value = "Date"
        Sheets(CSheet).Range("A2").Value = ">=" & dtmFrom
        Sheets(CSheet).Range("B2").Value = "<=" & dtmTo
    End If
'==================================
    
'Populate Orders Summary
'Run Advanced Filter
'==================================
    LastRow = Sheets(DSheet).Cells(1, 1).End(xlDown).Row
    Sheets(DSheet).Range("A1:F" & LastRow).AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets(CSheet).Range("A1:B2"), _
    CopyToRange:=Sheets(TSheet).Range("A9")
'==================================
        
'This code takes you to the Target WorkSheet where data was filtered to.
    Sheets(TSheet).Select

'Delete Criteria WorkSheet (without Prompt)
'==================================
    Application.DisplayAlerts = False
        Sheets(CSheet).Delete
    Application.DisplayAlerts = True
'==================================

'Populate Information about Orders Summary
'Total sales, income from sales, amount for environment etc.
'Total revenue from sales
Sheets("SummaryWorksheet").Select
Dim intRowCount As Integer
intRowCount = Sheets("SummaryWorksheet").UsedRange.Rows.count

'I commented out this section as I do not have or know of Worksheet "Roses".
'==================================
'Range("C10").Select
'Do Until IsEmpty(ActiveCell)
'    ActiveCell.Offset(0, 4).Value = WorksheetFunction.VLookup(ActiveCell, Worksheets("Roses").Range("A:B"), 2, False) * ActiveCell.Offset(0, 2)
'    ActiveCell.Offset(1, 0).Select
'Loop
'==================================

Range("G9:G" & intRowCount).Style = "Currency"
Range("G3").Value = WorksheetFunction.Sum(Range("E9:E" & intRowCount))
Range("G4").Value = WorksheetFunction.Sum(Range("G9:G" & intRowCount))
Range("G4").Style = "Currency"
Range("G3").NumberFormat = "#,##0"

'Greening the environment
Range("G5").Value = Range("G3") * 0.02
Range("G5").Style = "Currency"

'Borders for Order Summary Range and Autofitting all cells, change A8:F8 with automatic calculation of filled cells
Sheets("SummaryWorksheet").Select
Range("A9:G" & intRowCount).Select 'change this line to include all the entries not just the header, post import of filtered data
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

Cells.EntireColumn.AutoFit

Sheets("orders").Columns("G:G").ClearContents
Sheets("SummaryWorksheet").Select
End Sub

Also removed a lot of your "Selection" code.
I tried to add enough comments to let you know what the code is doing.
It copied a Date range into the Target worksheet in my test workbook.
Let me know if it helps.

 

[Chronix99]

I literally copied your code and pasted it into the sub and still it doesn't work. I'm starting to wonder if my workbook has something that prevents this from happening

Literally deleted my whole sub for the button click, pasted yours and ran it and the worksheet and everything gets created/formatted but no data

 

[Chronix99]

You are freaking kidding me.

It's been working all this time! Just that the userform takes the date as "mm/dd/yyyy" and I've been inserting it as "dd/mm/yyyy"

It's been coming up empty because I have no data from that period!!!!

 

[fullysic]

You are freaking kidding me.

It's been working all this time! Just that the userform takes the date as "mm/dd/yyyy" and I've been inserting it as "dd/mm/yyyy"

It's been coming up empty because I have no data from that period!!!!

I have had the same problem before when using the dd/mm/yy format. You need to pass your date variables to a long variable, and then use the long variable when trying to filter your records.

See my code below for an example:

Dim lDate1 As Long
Dim dDate1 As Date
If IsDate(Range("Date1")) Then
dDate1 = Range("Date1")
dDate1 = DateSerial(Year(dDate1), Month(dDate1), Day(dDate1))
End If
lDate1 = dDate1

Now lDate1 will be in the correct format (DD/MM/YY). Hope that helps.