Public Sub PromptUserForInputDates()

Dim strStart As String, strEnd As String, strPromptMessage As String
Dim LastOccupiedRowNum As String, LastOccupiedColNum As String
Dim strLocation As String


strStart = InputBox("Please enter the start date (mm/dd/yyyy)")

If Not IsDate(strStart) Then
    strPromptMessage = "Not Valid Date"

    MsgBox strPromptMessage

    Exit Sub
  End If

  strEnd = InputBox("Please enter the end date (mm/dd/yyyy)")

If Not IsDate(strStart) Then
strPromptMessage = "Not Valid Date"

MsgBox strPromptMessage


Exit Sub
End If

strLocation = InputBox("Please Enter the Location")

If strLocation = Empty Then
MsgBox strPromptMessage

Exit Sub
End If

Call CreateSubsetWorksheet(strStart, strEnd, strLocation)





 End Sub




   Public Sub CreateSubsetWorksheet(StartDate As String, EndDate As String, Location 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
Dim lngLocationCol As Long



Set wksData = ThisWorkbook.Worksheets("Sheet1")
lngDateCol = 4
lngLocationCol = 21


lngLastRow = LastOccupiedRowNum(wksData)
lngLastCol = LastOccupiedColNum(wksData)
With wksData
    Set rngFull = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol))
End With

  With rngFull
    .AutoFilter Field:=lngDateCol, _
                Criteria1:=">=" & StartDate, _
                Criteria2:="<=" & EndDate _

With rngFull
  .AutoFilter Field:=lngLocationCol, _
                Criteria1:=Location






    If wksData.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then

        MsgBox "Dates Filter out all data"

        wksData.AutoFilterMode = False
        If wksData.FilterMode = True Then
            wksData.ShowAllData
        End If
        Exit Sub

    Else

        Set rngResult = .SpecialCells(xlCellTypeVisible)

        Set wksTarget = ThisWorkbook.Worksheets.Add
        Set rngTarget = wksTarget.Cells(1, 1)
        rngResult.Range("A1:A5000").Copy Destination:=rngTarget
        Worksheets("Sheet1").Range("A1:A5000").Copy
        rngTarget.Range("A1").PasteSpecial Transpose:=True



    End If
    End With
    End With


wksData.AutoFilterMode = False
If wksData.FilterMode = True Then
    wksData.ShowAllData

End If

MsgBox "Data Transferred"

 End Sub

   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

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