looping to add large number of matrices in Excel VBA - excel

Question

I wanted to write a macro that can sum 1000 matrices of the same order (50 rows*30 columns) stacked in a sheet and separated by two empty rows...I did many trials uselessly...Can you provide/refer me to an example or book that deal with such problem? Thanks

Answer 1

Sum Up Matrices
Copy the two codes into a standard module (e.g. Module1).
Only the Sub is run, the Function is called by the Sub.
Adjust the constants including the workbooks.
The Code
Option Explicit
Sub sumUpMatrices()
' Source
Const srcName As String = "Sheet1"
Const srcFirstCell As String = "A1"
' Target
Const tgtName As String = "Sheet2"
Const tgtFirstCell As String = "A1"
' Matrices
Const mRows As Long = 50
Const mCols As Long = 30
Const mCount As Long = 1000
Const mEmpty As Long = 2
' Workbooks
Dim src As Workbook: Set src = ThisWorkbook
Dim tgt As Workbook: Set tgt = ThisWorkbook
' Write values from Source Range to Source Array.
Dim Source As Variant
Source = src.Worksheets(srcName).Range(srcFirstCell) _
.Resize(mCount * (mRows + mEmpty) - mEmpty, mCols)
' Write values from Source Array to Target Array.
Dim Target As Variant
Target = sumUpVerticalMatrices(Source, mRows, mCols, mCount, mEmpty)
' Write values from Target Array to Target Range.
tgt.Worksheets(tgtName).Range(tgtFirstCell).Resize(mRows, mCols) = Target
End Sub
Function sumUpVerticalMatrices(MatricesResult As Variant, _
ByVal RowsCount As Long, _
ByVal ColumnsCount As Long, _
ByVal MatricesCount As Long, _
ByVal Gap As Long) As Variant
Dim rOff As Long: rOff = RowsCount + Gap
Dim Result As Variant: ReDim Result(1 To RowsCount, 1 To ColumnsCount)
Dim i As Long, j As Long, k As Long, CurrVal As Double
For i = 1 To RowsCount
For j = 1 To ColumnsCount
CurrVal = 0
For k = 1 To MatricesCount
CurrVal = CurrVal + MatricesResult(i + (k - 1) * rOff, j)
Next k
Result(i, j) = CurrVal
Next j
Next i
sumUpVerticalMatrices = Result
End Function
Generate Random Data
Sub writeRandomVerticalMatrices()
' Worksheet
Const wsName As String = "Sheet1"
Const FirstCell As String = "A1"
' Matrices
Const mRows As Long = 50
Const mCols As Long = 30
Const mCount As Long = 1000
Const mEmpty As Long = 2
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook
' Write data to Data Array.
Dim Data As Variant
Data = getRandomVerticalMatrices(mRows, mCols, mCount, mEmpty)
' Write from Data Array to Worksheet
wb.Worksheets(wsName).Range(FirstCell) _
.Resize(UBound(Data), UBound(Data, 2)).Value = Data
End Sub
Function getRandomVerticalMatrices(ByVal RowsCount As Long, _
ByVal ColumnsCount As Long, _
ByVal MatricesCount As Long, _
ByVal Gap As Long) As Variant
Dim rOff As Long: rOff = RowsCount + Gap
Dim Result As Variant
ReDim Result(1 To MatricesCount * rOff - Gap, 1 To ColumnsCount)
Dim i As Long, j As Long, k As Long
For i = 1 To RowsCount
For j = 1 To ColumnsCount
For k = 1 To MatricesCount
Result(i + (k - 1) * rOff, j) = Int(500 * Rnd()) + 1
Next k
Next j
Next i
getRandomVerticalMatrices = Result
End Function

Answer 2

As you did not give much information I assume the first matrix starts in A1 and has 50 rows and 30 columns. Then you have two empty rows and then we have the next matrix, i.e. the second matrix starts in A53! Based on these assumptions you could put together the sum of these matrices like that
Option Explicit
Sub SumMat()
' This will build the formula for the first cell
' and copy & paste to the other cells
Const NO_LINES = 50
Const NO_MATRIX = 1000
Const NO_COLUMNS = 30
Const NO_EMPTYROWS = 2
' Const NO_LINES = 3
' Const NO_MATRIX = 5
' Const NO_COLUMNS = 3
' Const NO_EMPTYROWS = 2
Dim rg As Range
Dim offSet As Long
offSet = NO_LINES + NO_EMPTYROWS
' This will build the formula
' It is just A1 + A53 * A105 + A157 + ...
Dim i As Long
Dim formula(1 To NO_MATRIX) As String
Dim counter As Long
counter = 0
For i = 1 To NO_MATRIX
formula(i) = "A" & CStr(1) + counter * offSet
counter = counter + 1
Next i
' First cell of the result matrix is to the right with two empty columns to the source matrices
Set rg = Cells(1, NO_COLUMNS + 2)
' this will put the formula for the sum of the first cells into row 1 and in your case column 32
rg.formula = "=" & Join(formula, "+")
' Copy the formula
rg.Copy
' Resize the range to the size of the matrix
Set rg = rg.Resize(NO_LINES, NO_COLUMNS)
' paste the formula
rg.PasteSpecial xlPasteFormulas
End Sub