CODEWITHSUNDEEP
excelvbamatrix
Tameam Marghani
Tameam Marghani

Reputation: 13

looping to add large number of matrices in Excel VBA

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

Upvotes: 1

Views: 118

Answers (2)

VBasic2008
VBasic2008

Reputation: 54807

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

Upvotes: 1

Storax
Storax

Reputation: 12167

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

Upvotes: 1

Related Questions