VBA Coding to pull data - excel

Question

I have 50 .xls files saved on a shared drive by the name of users. Eg: "Rahul Goswami.xls", "Rohit Sharma.xls", etc.
Each Excel file contains 2 worksheets: "Case Tracker" and "Pending Tracker".
In the "Case Tracker" worksheet users put their daily data/ daily production.
I wanted VBA code to pull the entire "Case Tracker" worksheet from all 50 Excel files in one separate Excel workbook, one below the other.
Currently I am copy-pasting the data from the Excel files to the master workbook to "Sheet1".
Can there be something where I put the date and the data will come automatically for that date from all the 50 files?
Column A to J contains the data provided below. This example is given for 1 user.
Date Advisor Userid BP URN Stage Case Type Previous Status Current status Category
10-Apr Rahul Goswami goswami 123456 98765431 1 URN New Pend abc
Sub Beachson()
Dim z As Long, e As Long, d As Long, G As Long, h As Long Dim f As String
d = 2
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
## Heading ##
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Cells(Rows.Count, 1).End(xlUp).Row
For e = 2 To z
If Cells(e, 1) <> ActiveWorkbook.Name Then
Cells(d, 2) = Cells(e, 1)
Cells(1, 4) = "=Counta('" & Cells(1, 2) & "[" & Cells(e, 1) & "]Case Tracker'!I:I)"
For h = 10 To Cells(1, 4)
For G = 1 To 10
Cells(1, 3) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Case Tracker'!" & Chr(G + 64) & h
Cells(d, G + 2) = Cells(1, 3)
Next G
d = d + 1
Next h
End If
d = d + 1
Next e
MsgBox "collating is complete."
End Sub

Answer 1

I would avoid storing information in sheet, then going to VBA, then again to sheet, etc.
As for your problem of not being able to pull data when a file is open, I would suggest creating another instance of Excel.Application and opening files from it in ReadOnly mode.
This is the code which worked for me (the ability to find particular dates is also implemented):
Sub Beachson2()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
Dim App As Object
Set App = CreateObject("Excel.Application")
Dim wsSource As Worksheet
Dim sFold As String
sFold = ThisWorkbook.Path & "\"
Dim sFile As String
Dim i As Long, j As Long
Dim cell As Range
' Setting date
Dim sInput As String, dInput As Date
sInput = Application.InputBox("Enter A Date")
If IsDate(sInput) Then
dInput = DateValue(sInput)
Else
MsgBox "Invalid date. Exiting..."
Exit Sub
End If
Application.ScreenUpdating = False
' Pulling data
i = 1
sFile = Dir(sFold & "\*.xls")
Do While sFile <> ""
If sFile <> sFold & ThisWorkbook.Name Then
Set wsSource = App.Workbooks.Open(Filename:=sFold & sFile, ReadOnly:=True).Sheets("Case Tracker")
For Each cell In wsSource.Range("A1:A" & wsSource.UsedRange.Rows.Count)
If cell.Value = CStr(dInput) Then
With ws.Cells(Rows.Count, 1).End(xlUp)
If IsEmpty(.Value2) Then
.Value2 = sFile
ElseIf .Value2 <> sFile Then
.Offset(1).Value2 = sFile
Else
'do nothing
End If
End With
If ws.Cells(Rows.Count, 2).End(xlUp).Value2 <> sFile Then
ws.Cells(i, 2).Value2 = sFile
End If
For j = 3 To 12
ws.Cells(i, j).Value = wsSource.Cells(cell.Row, j - 2).Value
Next
i = i + 1
End If
Next
wsSource.Parent.Close
End If
sFile = Dir()
Loop
Application.ScreenUpdating = True
App.Quit
MsgBox "collating is complete."
Set App = Nothing
End Sub
The code is stored in the master file.
Even in the code there is no one specific Date format defined, but I still think it is capable of causing problems. If you find problems regarding date formats, please post your used date format.