Sum of column values in named region

Question

I have a workbook that has thousands of defined name regions located in various worksheets. I'm trying to extract them all and line them up in another workbook.

Most of the defined name regions are 1 row tall (and hundreds of cols wide)... but a few are 3-4 rows tall.

So for example,

Name1

10 5 10 12 30 10 12 10 5 10 12 30 10 12 ...

Name2

10 11 10 12 30 10 12 10 11 10 12 30 10 12 ...
10 11 10 12 30 10 12 10 11 10 12 30 10 12 ...
10 11 10 12 30 10 12 10 11 10 12 30 10 12 ...

For instances where the region is more than one row tall, I'd like to collapse it to a single row by taking the SUM of the entire column.

So Name2 would be copied to the new workbook as the following:

30 33 30 36 90 30 36 30 33 30 36 90 30 36

I have some VBA/VBS written that works perfectly (and fast!) for cases where the region is 1 row tall, but I'm not sure how to handle summing the taller regions in an efficient way.

What's the best way to fill in the question marks below?

My code so far hasn't had to explicitly loop through the cells of a region; I'm hoping that that won't be the case here either. Any advice appreciated!

Dim irow
irow = 0
Dim colsum

'rem Loop through all names and copy over the valid ones
For Each nm in wbSource.Names

    'rem Dont copy any name that isnt visible
    If nm.Visible = True Then

        'rem Only copy valid references that start with "ByWeek"
        If InStr(1, nm.RefersTo, "#REF") = 0 And InStr(1, nm.Name, "ByWeek") > 0 Then

            'rem Only copy if the range is one row tall
            If nm.RefersToRange.Row.Count = 1 Then
                wsDest.Range("A3").Offset(irow, 0).Value = nm.Name
                wsDest.Range("A3",wsDest.Cells(3,nm.RefersToRange.Columns.Count+1)).Offset(irow, 1).Value = nm.RefersToRange.Value
                irow = irow + 1     

            ' rem If the named region is several rows tall, then squish it into one row by taking SUM of each column
            elseif  nm.RefersToRange.Row.Count > 1 Then
                wsDest.Range("A3").Offset(irow, 0).Value = nm.Name
                ???????????????????????????????????
                irow = irow + 1                     

            End If      
        End If  
    End if
Next

Answer 1

You can update your code such that it adds all the cells in the given range (nm.RefersToRange), independently upon the number of cells:

Dim irow
irow = 0

'rem Loop through all names and copy over the valid ones
For Each nm in wbSource.Names

    'rem Dont copy any name that isnt visible
    If nm.Visible = True Then

        'rem Only copy valid references that start with "ByWeek"
        If InStr(1, nm.RefersTo, "#REF") = 0 And InStr(1, nm.Name, "ByWeek") > 0 Then
            If nm.RefersToRange.Rows.Count >= 1 Then
                wsDest.Range("A3").Offset(irow, 0).Value = nm.Name
                Dim totVal As Long: totVal = 0   'I assumed that target values are Long; update this to the proper type is required
                For Each cell In nm.RefersToRange.Cells
                    If (IsNumeric(cell.Value)) Then totVal = totVal + cell.Value
                Next
                wsDest.Range("A3", wsDest.Cells(3, nm.RefersToRange.Columns.Count + 1)).Offset(irow, 1).Value = totVal
                irow = irow + 1  
            End If  
        End If  
    End if
Next

Answer 2

there is no best way as everyone might think their way is the best.

I would suggest using arrays instead of working with the range objects directly as arrays would have been much faster.

Consider

Now running the code

Option Explicit

Sub Main()

    Dim lastRow As Long
    Dim lastCol As Long

    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

    Dim arr As Variant
    arr = Range(Cells(1, 1), Cells(lastRow, lastCol))

    ReDim sumArr(UBound(arr, 2)) As Variant
    Dim i As Long
    Dim j As Long
    Dim colSum As Long

    For i = LBound(arr, 1) To UBound(arr, 2)
        For j = LBound(arr, 1) To UBound(arr, 1)
            colSum = colSum + arr(j, i)
        Next j
        sumArr(i) = colSum
        colSum = 0
    Next i

    ReDim finalArray(UBound(sumArr) - 1) As Variant
    For i = 1 To UBound(sumArr)
        finalArray(i - 1) = sumArr(i)
    Next i

    Range("A10").Resize(1, UBound(finalArray, 1) + 1) = finalArray

End Sub

Results in

---

The idea to use arrays is taken from here

And all you need to do is modify the range you want to reprint the array to

Range("A10").Resize(1, UBound(finalArray, 1) + 1) = finalArray

So if you use the above code I think all you'll need to change will be

wsDest.Range("A3").Resize(1, UBound(finalArray, 1) + 1) = finalArray

Answer 3

Here's the code I ended using: It loops through each column for the defined named range. It isn't fast, but it works well enough, as 90% of my ranges are just one row tall.

I've just inserted this code where where it says ????...???? in my question above, :

                        For j = 1 To nm.RefersToRange.Columns.Count
                            colsum  = 0
                            For i = 1 To nm.RefersToRange.Rows.Count
                              If IsNumeric(nm.RefersToRange.Cells(i, j).Value) Then                  
                                    colsum = colsum + nm.RefersToRange.Cells(i, j).Value
                              End If                  
                            Next
                            wsDest.Range("A3").Offset(irow, j).Value = colsum
                        Next