Loop through all files in folder and extract rows with specified date range from input box

[Jim885]

We have the below code that extracts data from the file where the code resides. We now need to modify the code to loop through all files within the same folder and extract the same information from a specified date or date range, which comes from input boxes. The input box code works flawlessly.

The information needed to be copied to the Report Workbook would be a range of columns A to J from all queried files that meet the date range of the input boxes. The date is always in column A of each worksheet
All files are identical in structure, and all worksheets that contain the data have the same name, which is "Summary"

Not all files may have line item entries for the day(s) being queried, so that situation should not result in an error to the code.

When each file is queried, it should be closed without being saved or changed.

Sub SumReportLog()
Dim wsSource As Worksheet
Dim sPrompt As Variant
Dim sTitle As Variant
Dim DateIn(2) As Variant
Dim Date1 As Variant
Dim i As Integer
Dim LineFeed As String
LineFeed = Chr(10) & Chr(10)

On Error GoTo myerror

' worksheet containing the data source

    Set wsSource = Sheets("Summary")
   

    sPrompt = Array("Enter Beginning Date." & vbCrLf & "(First day of the range)", _
"Enter Ending Date." & vbCrLf & "(Last Day)")
sTitle = Array("Beginning Date", "End Date")
Date1 = DateIn(i)
DateIn(0) = Date2
i = 0
Do
DateIn(i) = InputBox(sPrompt(i), sTitle(i), Format(Now(), "m/dd/yyyy"))
If DateIn(i) = vbNullString Then
msg = MsgBox("Do You Want To Quit?" & Space(10), 36, "Exit Application")
If msg = 6 Then Exit Sub
ElseIf Not IsDate(DateIn(i)) Then
MsgBox DateIn(i) & Chr(10) & "Is Not A Valid Date", 16, "Error Alert"
Else
DateIn(i) = CDate(DateIn(i))
i = i + 1
End If
If i > 1 And DateIn(1) < DateIn(0) Then
MsgBox " The End Date that was entered: " & DateIn(1) & LineFeed & _
"Is earlier than the Beginning Date: " & DateIn(0) & Space(10), 16, "Input Error"
i = i - 1
End If
    Loop Until i > 1

'=======================================
' Clear the PrintOut Sheets for new Data
'=======================================
Sheets("SummaryAll").Cells.Delete shift:=xlUp

'=========
' Get Data
'=========
GetData wsSource, DateIn(0), DateIn(1)

myerror:
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
    Application.ScreenUpdating = True

End Sub

Sub GetData(ByVal ws As Object, ByVal StartDate As Date, ByVal EndDate As Date)
Dim lr As Long
Dim lStartdate As Long
Dim lEndDate As Long
Dim Rng As Range
Dim FilterRange As Long

Application.ScreenUpdating = False
lStartdate = DateSerial(Year(StartDate), Month(StartDate), Day(StartDate))
    lEndDate = DateSerial(Year(EndDate), Month(EndDate), Day(EndDate))


' Filter the Date Range
Sheets("Summary").Unprotect
With ws
lr = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:J" & lr).AutoFilter field:=1, _
Criteria1:=">=" & lStartdate, _
Operator:=xlAnd, _
                                       Criteria2:="<=" & lEndDate

       Set Rng = .AutoFilter.Range
FilterRange = Rng.Columns(10).SpecialCells(xlCellTypeVisible).Count - 1
If FilterRange > 0 Then

'Copy range A to J
.Range("A1:J" & lr).SpecialCells(xlCellTypeVisible).Copy

With ThisWorkbook.Worksheets("SummaryAll").Range("A2")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
Else
Rng.AutoFilter
Application.ScreenUpdating = True
MsgBox "No Data found within Date Range Entered", , "No Data Found"
Exit Sub
End If
End With
 Rng.AutoFilter

    With Worksheets("SummaryAll")
.Columns("A:J").EntireColumn.AutoFit
End With

Application.ScreenUpdating = True

    ThisWorkbook.Save
End Sub

The desired result should look like this.

I've been working on this for days and can't seem to get close. I know someone can make this look easy.
Thank you in advance.

Date	Name	Site	Tech	Job	Total Count	$ Each	Total	Finished	Completed $
3/18/2020​	Jack	NY	Bill	Albany	420​	$ 154.00	$ 64,680.00	22​	$ 3,388.00
			Total						$ 3,388.00
3/18/2020​	Jack	TX	Henry	Dallas	153​	$ 62.00	$ 9,486.00	48​	$ 2,976.00
			Total						$ 2,976.00
3/18/2020​	Jack	NY	Roy	Buffolo	524​	$ 41.00	$ 21,484.00	212​	$ 8,692.00
3/18/2020​	Jack	NY	Roy	Buffolo	54​	$ 57.00	$ 3,078.00	16​	$ 912.00
			Total						$ 9,604.00
3/18/2020​	Jack	FL	Sean	Jax	84​	$ 120.00	$ 10,080.00	15​	$ 1,800.00
3/18/2020​	Jack	FL	Sean	Jax	92​	$ 80.00	$ 7,360.00	40​	$ 3,200.00
3/18/2020​	Jack	FL	Sean	Jax	61​	$ 43.00	$ 2,623.00	32​	$ 1,376.00
			Total						$ 6,376.00
			Grand Total						$ 22,344.00

 

[davesexcel]

Can you link us to a sample workbook that we can test the codes with?