You're not very specific about what you want, so here's a generic
example - hopefully it gets you started. I haven't spent much time
debugging it, just making sure that it works. It literally does no
error checking as far as file names - assumes that all Excel files in
folder "A" begin with a 3-letter project code, followed immediately by
an Excel-valid date text. Best of luck.
' ***** Begin Description *****
On my C:\ drive, I created a folder called "crunch". In it, I created
two subdirectories called "A" and "B".
In "A", you have your worksheets with trial data. Each workbook has a
sheet called "DataSheet" and contains the numbers for the trial
in range A1:A10.
In "B", you have the workbook called summary.xls. It has a worksheet
called "SummarySheet". On this worksheet, column A contains project
names, and row 1 contains date headers of the trials.
The procedure below does the following:
1. Asks user to enter starting date
2. Makes a list of all files in folder "A" whose last-modified date is
on or after starting date, and matches the *.xl* pattern
3. Goes through this list, and opens each file.
4. Determines the project name (first 3 letters of the file name) and
project date (letter 4 up until the .xls) from file name
5. Looks for the project name in SummarySheet first column
6. If project name does not exist, it adds it at the bottom
7. Looks for the project date in SummarySheet first row
8. If project date does not exist, it adds it to the right
9. Calculates average for each project's data (A1:A10)
10. Closes all workbooks - not saving anything in folder "A", but
saving summary.xls
' ***** Begin Code *****
Option Explicit
Public Sub GetFileNames()
Const currDir = "C:\Crunch\"
Dim fileName As String
Dim fileCount As Long
' used in current workbook
Dim wshFileList As Excel.Worksheet
Dim rngFileList As Excel.Range
Dim rngMyFile As Excel.Range
' used to summarize data
Dim wkbSummary As Excel.Workbook
Dim wshSummary As Excel.Worksheet
Dim wkbSource As Excel.Workbook
Dim rngSourceProj As Excel.Range
Dim rngSourceDate As Excel.Range
' used to find correct summary cell to populate
Dim strProjName As String
Dim dtProjDate As Date
Dim dtFromDate As Date
' track row, column
Dim i As Long, j As Long
On Error Resume Next
dtFromDate = Application.InputBox( _
"Enter starting date: ", , , , , , , 1)
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
Set wshFileList = ThisWorkbook.Worksheets.Add
With wshFileList
' .Visible = xlSheetVeryHidden
On Error Resume Next
.Name = "File List"
If Err.Number <> 0 Then
Application.DisplayAlerts = False
wshFileList.Parent.Worksheets( _
"File List").Delete()
Application.DisplayAlerts = True
.Name = "File List"
End If
fileName = Dir(currDir & "A\*.xl*", vbDirectory)
Do While Len(fileName) <> 0
If (FileDateTime(currDir & "A\" & _
fileName) >= dtFromDate) Then
.Cells(WorksheetFunction.CountA( _
.Range("A:A")) + 1, 1).Value = fileName
fileCount = fileCount + 1
End If
fileName = Dir()
Loop
If fileCount < 1 Then
Call MsgBox("No files found matching criteria")
Exit Sub
End If
rngFileList = .Range(.Cells(1, 1), _
.Cells(fileCount, 1))
End With
Set wkbSummary = _
Application.Workbooks.Open( _
currDir & "B\summary.xls")
Set wshSummary = wkbSummary.Sheets("SummarySheet")
With wshSummary
For Each rngMyFile In rngFileList
Set wkbSource = _
Application.Workbooks.Open( _
currDir & "A\" & rngMyFile.Value)
strProjName = Left$(rngMyFile.Value, 3)
dtProjDate = CDate(Left$(Right$( _
rngMyFile.Value, Len(rngMyFile.Value) - 3), _
InStr(1, rngMyFile.Value, ".") - 1 - 3))
Set rngSourceProj = .Range("$A:$A").Find(strProjName)
If rngSourceProj Is Nothing Then
rngSourceProj = .Cells( _
.UsedRange.Rows.Count + 1, 1)
rngSourceProj.Value = strProjName
End If
Set rngSourceProj = rngSourceProj.EntireRow
Set rngSourceDate = _
.Range("$1:$1").Find(dtProjDate)
If rngSourceDate Is Nothing Then
rngSourceDate = .Cells( _
1, .UsedRange.Columns.Count + 1)
rngSourceDate.Value = dtProjDate
End If
Set rngSourceDate = rngSourceDate.EntireColumn
i = Intersect(rngSourceProj, rngSourceDate).Row
j = Intersect(rngSourceProj, rngSourceDate).Column
.Cells(i, j) = _
Application.WorksheetFunction.Average( _
wkbSource.Worksheets("DataSheet").Range("$A$1:$A$10"))
wkbSource.Close (False)
Next rngMyFile
wkbSummary.Close (True)
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub
' ***** End Code *****
