Totalfile - calculatesums and place in correct range


New Member
Sep 1, 2010

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. ??

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
        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
                    Sheet1.Cells(cell.Row, cell.Column) = ""
                End If
            End If
        Next cell
    Next rngIndex
    Exit Sub
    MsgBox "Failed: " & fname
End Sub

Forum statistics

Latest member

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...