SJ McAbney
09-07-2004, 02:53 AM
I have a spreadsheet that collects information from a number of different spreadsheets in the same directory.
It's one of those where one person has their own spreadsheet, another has theirs, etc. There is also a summary sheet that adds up the values over the different spreadsheets. Each sheet - including the summary has the same layout.
The problem is that as people come and go their will need to be a different spreadsheet for each person detailing their workloads. I could manually change the summary spreadsheet's formulae but this is too time consuming and I don't, to be honest, trust those who'll be using it going forward to do this on their own.
I've tried and played about with this code:
Sub Button1_Click()
Const strExtension As String = "\*.xls"
Const bytMonth = 1
Dim strFileList() As String
Dim rng As Range, strTemp As String
Dim strFileName As String
Dim strPathName As String
Dim intIndex As Integer
strPathName = ActiveWorkbook.Path
strFileName = Dir(strPathName & strExtension)
While strFileName <> vbNullString
ReDim Preserve strFileList(0 To intIndex)
If Not strFileName Like "Summary*" Then
strFileList(intIndex) = strFileName
End If
strFileName = Dir()
intIndex = intIndex + 1
Wend
If intIndex = 0 Then
MsgBox "No files found"
Exit Sub
End If
Range("D8:N38").Select
For Each rng In Selection
strTemp = vbNullString
For intIndex = 1 To UBound(strFileList)
If Not strFileList(intIndex) = vbNullString Then
strTemp = strTemp & "'" & ActiveWorkbook.Path & "[" & strFileList(intIndex) & "]" & MonthName(bytMonth) & "'!" & rng.Address & ","
End If
Next intIndex
strTemp = "=SUM(" & Left(strTemp, Len(strTemp) - 1) & ")"
rng.Formula = strTemp
Next
End Sub
The idea is that each cell within the range would provide a SUM formula or value (if need be).
It's one of those where one person has their own spreadsheet, another has theirs, etc. There is also a summary sheet that adds up the values over the different spreadsheets. Each sheet - including the summary has the same layout.
The problem is that as people come and go their will need to be a different spreadsheet for each person detailing their workloads. I could manually change the summary spreadsheet's formulae but this is too time consuming and I don't, to be honest, trust those who'll be using it going forward to do this on their own.
I've tried and played about with this code:
Sub Button1_Click()
Const strExtension As String = "\*.xls"
Const bytMonth = 1
Dim strFileList() As String
Dim rng As Range, strTemp As String
Dim strFileName As String
Dim strPathName As String
Dim intIndex As Integer
strPathName = ActiveWorkbook.Path
strFileName = Dir(strPathName & strExtension)
While strFileName <> vbNullString
ReDim Preserve strFileList(0 To intIndex)
If Not strFileName Like "Summary*" Then
strFileList(intIndex) = strFileName
End If
strFileName = Dir()
intIndex = intIndex + 1
Wend
If intIndex = 0 Then
MsgBox "No files found"
Exit Sub
End If
Range("D8:N38").Select
For Each rng In Selection
strTemp = vbNullString
For intIndex = 1 To UBound(strFileList)
If Not strFileList(intIndex) = vbNullString Then
strTemp = strTemp & "'" & ActiveWorkbook.Path & "[" & strFileList(intIndex) & "]" & MonthName(bytMonth) & "'!" & rng.Address & ","
End If
Next intIndex
strTemp = "=SUM(" & Left(strTemp, Len(strTemp) - 1) & ")"
rng.Formula = strTemp
Next
End Sub
The idea is that each cell within the range would provide a SUM formula or value (if need be).