Sum Values in different worksheets (same cell)

Viewed 115

I have a workbook with multiple sheets ,the number of sheets can change for each project but they all end with PAF. The table is the same across all sheets as well as the cells.

I have a summary tab with the exact same table, I just need to sum it all up there, the table has at least 6 columns and 20 rows so each cell would need the same formula (basically) so I came up with the following but I'm getting an error. Any suggestions?

Sub SumPAF
Dim ws as Worksheet
Sheets("Summary PAF").Activate

For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "PAF" Then

Range("E10") = WorksheetFunction.Sum(Range("E10"))

End If
Next
End Sub

It's getting stuck in "For Each" saying that an Object is required...

2 Answers

I have commented the code so you should not have a problem understanding it.

Option Explicit

Sub SumPAF()
    Dim ws As Worksheet
    
    '~~> This will store the cell addresses
    Dim sumFormula As String
    
    '~~> Loop though each worksheet and check if it ends with PAF
    '~~> and also to ingore summary worksheet
    For Each ws In ActiveWorkbook.Worksheets
        If UCase(ws.Name) Like "*PAF" And _
        InStr(1, ws.Name, "Summary", vbTextCompare) = 0 Then _
        sumFormula = sumFormula & "," & "'" & ws.Name & "'!E10"
        '~~> or simply 
        'sumFormula = sumFormula & ",'" & ws.Name & "'!E10"
    Next
    
    '~~> Remove the intital ","
    sumFormula = Mid(sumFormula, 2)
    
    '~~> Insert the sum formula
    If sumFormula <> "" Then _
    Sheets("Summary PAF").Range("E10").Formula = "=SUM(" & sumFormula & ")"
End Sub

Here's a very simple and easy to understand program to illustrate how VBA can be used for loops over ranges. If you have any questions, feel free to ask:

Sub SumPAF()
    'Save a reference to the Summary Sheet
    Dim SummarySheet As Worksheet
    Set SummarySheet = Sheets("Summary PAF")
    
    'Save a reference to the Summary Table and decide the table dimensions
    Dim SummaryTable As Range
    Set SummaryTable = SummarySheet.Range("A1:F20")
    
    'Create an array to save the sum values
    Dim SumValues() As Double
    ReDim SumValues(1 To SummaryTable.Rows.Count, 1 To SummaryTable.Columns.Count)
    
    'Loop through the workbook sheets
    Dim ws As Worksheet, TableRange As Range
    For Each ws In ActiveWorkbook.Worksheets
        'Find sheets ending in PAF other than the summary PAF
        If ws.Name Like "*PAF" And Not ws.Name = SummarySheet.Name Then
            'create a reference to a range on the sheet in the same place and dimensions as the summary table
            Set TableRange = ws.Range(SummaryTable.Address)
            
            'loop through the range, cell by cell
            Dim i As Long, j As Long
            For i = 1 To TableRange.Rows.Count
                For j = 1 To TableRange.Columns.Count
                    'Sum each cell value into the array, where its cell address is the array coordinates.
                    SumValues(i, j) = SumValues(i, j) + TableRange.Cells(i, j).Value
                Next j
            Next i
        End If
    Next
    
    'Output the array into the summary table
    SummaryTable.Value = SumValues
End Sub
Related