Cross-sheet sum and speed performance

Question

I am trying to sum a lot of sheets (11-12) to a master called "Total - Resources" I have multiple ranges I wan't to sum cell-for-cell however I can't seem to find a solution to add multiple ranges that needs to be added in the sht.Range? I am also experience massive speed problems when trying to add the different ranges like this... Is there a better, more straight forward way to do the same as described in the code.

• Use more ranges

• Speed performance

  For Each Sht In ThisWorkbook.Worksheets
      If Sht.Name Like "*- Resources" Then
          For Each cell In Sht.Range("G11:G46")'Add another range "G22:G46","F46.."?
              Cast = cell.Address
              Sheets("Total - Resources").Range(Cast) = Sheets("Total - Resources").Range(Cast) + cell.Value
          Next cell
      End If
  Next Sht
  

Answer 1

I would suggest the following:

1. Define your addresses SumAddresses that should sum up.
2. Handle these addresses area by area.
   The address A1:C4,A7:C10 consists of 2 areas: A1:C4 and A7:C10
3. Work with arrays. That means read the data in each area into an array. Then perform the sum calculation with the array, and in the end write that array into the destination area in your Total worksheet. Working with arrays in much faster than using ranges.

So you end up with something like:

Option Explicit

Public Sub SumResourceSheets()
    Dim SumAddresses As String
    SumAddresses = "A1:C4,A7:C10,D5" 'note this is limited to 255 characters!

    Dim ResultRange As Range
    Set ResultRange = ThisWorkbook.Worksheets("Total - Resources").Range(SumAddresses)
    ResultRange.ClearContents 'make result range epmty

    ReDim SumAreas(1 To ResultRange.Areas.Count) As Variant
    Dim iArea As Long
    For iArea = LBound(SumAreas) To UBound(SumAreas)
        SumAreas(iArea) = ResultRange.Areas(iArea).Cells.Value 'read area into array

        Dim ws As Worksheet
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name Like "*- Resources" And ws.Name <> "Total - Resources" Then 'exclude Total - Resources
                If ws.Range(ResultRange.Areas(iArea).Address).Cells.CountLarge = 1 Then
                    'handle single cell areas…
                    SumAreas(iArea) = SumAreas(iArea) + ws.Range(ResultRange.Areas(iArea).Address).Value
                Else
                    'this is for multi cell areas …

                    'read data area into array
                    Dim DataArea() As Variant
                    DataArea = ws.Range(ResultRange.Areas(iArea).Address).Value

                    'sum data into sum array
                    Dim iRow As Long
                    For iRow = LBound(DataArea, 1) To UBound(DataArea, 1)
                        Dim iCol As Long
                        For iCol = LBound(DataArea, 2) To UBound(DataArea, 2)
                            If IsNumeric(DataArea(iRow, iCol)) Then
                                SumAreas(iArea)(iRow, iCol) = SumAreas(iArea)(iRow, iCol) + DataArea(iRow, iCol)
                            Else
                                MsgBox "The cell '" & ResultRange.Areas(iArea).Cells(iRow, iCol).Address & "' in worksheet '" & ws.Name & "' does not contain a number!", vbCritical
                                Exit Sub
                            End If
                        Next iCol
                    Next iRow
                End If
            End If
        Next ws

        ResultRange.Areas(iArea).Cells.Value = SumAreas(iArea) 'write area into cell
    Next iArea
End Sub