This macro prompts you to select a date range then copies the rows in that range to a new worksheet

copy_date_range_data_to_new_worksheet.vb

Option Explicit

'This subroutine prompts the user to select dates
'
'Code already written and described here:
'http://danwagner.co/how-to-copy-data-to-a-new-workbook-based-on-dates/
Public Sub PromptUserForInputDates()
    
    Dim strStart As String, strEnd As String, strPromptMessage As String
    
    'Prompt the user to input the start date
    strStart = InputBox("Please enter the start date")
    
    'Validate the input string
    If Not IsDate(strStart) Then
        strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                           "date. Please retry with a valid date..."
        MsgBox strPromptMessage
        Exit Sub
    End If
    
    'Prompt the user to input the end date
    strEnd = InputBox("Please enter the end date")
    
    'Validate the input string
    If Not IsDate(strStart) Then
        strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                           "date. Please retry with a valid date..."
        MsgBox strPromptMessage
        Exit Sub
    End If
    
    'Call the next subroutine, which will do produce the output workbook
    Call CreateSubsetWorksheet(strStart, strEnd)
    
End Sub

'This subroutine creates a new Worksheet and copies the data
'from Sheet1 to a new Workheet
Public Sub CreateSubsetWorksheet(StartDate As String, EndDate As String)

    Dim wksData As Worksheet, wksTarget As Worksheet
    Dim lngLastRow As Long, lngLastCol As Long, lngDateCol As Long
    Dim rngFull As Range, rngResult As Range, rngTarget As Range
    
    'Set references up-front
    Set wksData = ThisWorkbook.Worksheets("Sheet1")
    lngDateCol = 8 '<~ we know dates are in column H
    
    'Identify the full data range on Sheet1 (our data sheet) by finding
    'the last row and last column
    lngLastRow = LastOccupiedRowNum(wksData) '<~ straight from VBA Toolbelt!
    lngLastCol = LastOccupiedColNum(wksData) '<~ straight from VBA Toolbelt!
    With wksData
        Set rngFull = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol))
    End With
    
    'Apply a filter to the full range we just assigned to get rows
    'that are in-between the start and end dates
    With rngFull
        .AutoFilter Field:=lngDateCol, _
                    Criteria1:=">=" & StartDate, _
                    Criteria2:="<=" & EndDate
        
        'If the resulting range contains only 1 row, that means we filtered
        'everything out! Check for this situation, catch it and exit
        If wksData.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
        
            MsgBox "Oops! Those dates filter out all data!"
            
            'Clear the autofilter safely and exit sub
            wksData.AutoFilterMode = False
            If wksData.FilterMode = True Then
                wksData.ShowAllData
            End If
            Exit Sub
            
        Else '<~ otherwise we're all good!
        
            'Assign ONLY the visible cells, which are in the
            'date range specified
            Set rngResult = .SpecialCells(xlCellTypeVisible)
            
            'Create a new Worksheet to copy our data to and set up
            'a target Range (for super easy copy / paste)
            Set wksTarget = ThisWorkbook.Worksheets.Add
            Set rngTarget = wksTarget.Cells(1, 1)
            rngResult.Copy Destination:=rngTarget
        End If
    End With
    
    'Clear the autofilter safely
    wksData.AutoFilterMode = False
    If wksData.FilterMode = True Then
        wksData.ShowAllData
    End If
    
    'Holler at the user, our macro is done!
    MsgBox "Data transferred!"

End Sub

'
'The functions below are pulled straight from the VBA Toolbelt,
'which you're using -- right? This kind of boilerplate code is what
'makes the VBA Toolbelt so useful! Download it here:
'
'http://danwagner.co/vba-toolbelt/

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last row
'OUTPUT      : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last column
'OUTPUT      : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column
        End With
    Else
        lng = 1
    End If
    LastOccupiedColNum = lng
End Function

Hey Hi

the code is awesome but I keep getting error for "Run Time Error 1004: Autofilter Method Of Range Class Failed "
I am trying to filter based on dates in a column with dates from 3/26/2018 to 5/20/2030. it executes for date filtering from 03/26/2018 to 4/30/2019 but not any further.

PLease help !!

'Apply a filter to the full range we just assigned to get rows
'that are in-between the start and end dates
With rngFull
.AutoFilter Field:=lngDateCol, _
Criteria1:=">=" & StartDate, _
Criteria2:="<=" & EndDate