Hello!
I am working on a budgetsystem, we have lots of excelfiles. Each department on the company put in values in these files where we have set the template for the appreance. All files look the same.
On top of all this we have a files that goes thru all the files and calculates the values for each department.
Now, what i want to do is to take the value from all the files (departments) and put them in the right place in the totalfile where the values are calculated. With the function CalculateSums it takes the values from all the files where the specified range is for example C80:N85.. now this method only places the values in the same place in the total file. How can i change that so i can place it in another range, like C30:N35 etc. ??
Regards
Anders
I am working on a budgetsystem, we have lots of excelfiles. Each department on the company put in values in these files where we have set the template for the appreance. All files look the same.
On top of all this we have a files that goes thru all the files and calculates the values for each department.
Now, what i want to do is to take the value from all the files (departments) and put them in the right place in the totalfile where the values are calculated. With the function CalculateSums it takes the values from all the files where the specified range is for example C80:N85.. now this method only places the values in the same place in the total file. How can i change that so i can place it in another range, like C30:N35 etc. ??
Code:
Sub CalculateSums(baseDir As String, fname As String)
Dim rngIndex As Integer
Dim j As Integer
Dim newSum As Long
Dim fileExpression As String
Dim previousSum As Long
previousSum = 0
On Error GoTo CalculateSums_Err
If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect Password:="PASSWORD"
End If
For rngIndex = 0 To 0
With Sheet2.Range(ranges(rngIndex))
'If the cell in Sheet1 of the closed workbook is not
'empty the pull in it's content, else put in an Error.
fileExpression = "'" & baseDir & "[" & fname & "]Sheet1'!RC="""",0,'" & baseDir & "[" & fname & "]Sheet1'!RC"
.FormulaR1C1 = "=IF(" & fileExpression & ")"
'Delete all Error cells
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, xlErrors).Clear
On Error GoTo 0
'Change all formulas to Values only
.Value = .Value
End With
Sheet1.Select
Dim cell
Dim oldVal As Long
Dim newVal As Long
For Each cell In Sheet2.Range(ranges(rngIndex))
oldVal = Sheet1.Cells(cell.Row, cell.Column)
If IsNumeric(cell.Value) Then
newVal = oldVal + cell.Value
If newVal <> 0 Then
Sheet1.Cells(cell.Row, cell.Column) = newVal
Else
Sheet1.Cells(cell.Row, cell.Column) = ""
End If
End If
Next cell
Next rngIndex
CalculateSums_End:
Exit Sub
CalculateSums_Err:
MsgBox "Failed: " & fname
End Sub
Regards
Anders