Adding arrays together (in VBA) for output

Question

Is it possible for me to add arrays together for an output?

The code does match with headers and returns values to various arrays. when I try to output my arrays and add the values together I get

type mismatch

on line

.Range("B" & lastrow + 1 & ":" & "H" & lastrow + 1).Value = Application.Transpose(R) + Application.Transpose(M) + Application.Transpose(O) + Application.Transpose(Q)

in the following code:

Const FirstMatch As Boolean = True
Dim SR As Variant
Dim OAS As Variant
Dim iSR As Integer
Dim iOAS As Integer
Dim R As Variant
Dim M As Variant
Dim O As Variant
Dim Q As Variant
Dim headers As Variant
Dim iheaders As Integer

SR = Worksheets("Sheet A").Range("D3:J7").Value  ' Array for CS01 Data
OAS = Worksheets("Sheet A").Range("D28:J35").Value 'Array for MBS Data
headers = Worksheets("Sheet B").Range("B1:H1").Value

With Worksheets("Sheet B")
    ReDim R(1 To UBound(SR, 2), 1 To 1)
    ReDim M(1 To UBound(SR, 2), 1 To 1)
    ReDim O(1 To UBound(SR, 2), 1 To 1)
    ReDim Q(1 To UBound(SR, 2), 1 To 1)

    For iheaders = 1 To UBound(headers, 2)
        For iSR = 1 To UBound(SR, 2)
            If headers(1, iheaders) = SR(1, iSR) Then
                R(iSR, 1) = SR(5, iSR)
                If FirstMatch Then
                    Exit For
                End If
            End If
        Next

        For iOAS = 1 To UBound(OAS, 2)
            If headers(1, iheaders) = OAS(1, iOAS) Then
                M(iOAS, 1) = OAS(6, iOAS)
                O(iOAS, 1) = OAS(7, iOAS)
                Q(iOAS, 1) = OAS(8, iOAS)
                If FirstMatch Then
                    Exit For
                End If
            End If
        Next
    Next

    .Range("B" & lastrow + 1 & ":" & "H" & lastrow + 1).Value = Application.Transpose(R) + Application.Transpose(M) + Application.Transpose(O) + Application.Transpose(Q)
End With

You had a typo on your OAS = line - you were missing a quotation mark for some reason. I've edited it for you. — dwirony
– dwirony, Commented Nov 27, 2018 at 21:10
This code seem unnecessarily complicated, it could be rewritten with a single for loop and without relative indices — Uri Goren
– Uri Goren, Commented Dec 1, 2018 at 17:42
It looks like you're adding two matrices and then transposing. Why not write it explicitly in loop instead of creating the intermediate R, M, O, Q SR and OAS variables ? — Uri Goren
– Uri Goren, Commented Dec 2, 2018 at 12:40
Added a later approach using the advanced filtering possibilites of the Application.Index function :-) @excelguy — T.M.
– T.M., Commented Dec 5, 2018 at 7:58

Pᴇʜ · Accepted Answer · 2018-12-04 08:07:15Z

8

+50

Approach with matrix multiplication

To add up 2 arrays that are 1-dimensional you can do the following mathematical trick and multiply an array of your 4 arrays with an Array(1, 1, 1, 1) using the WorksheetFunction.MMult method which results in the sum of that 4 arrays (due to matrix multiplication rules):

Option Explicit

Public Sub AddArrays()
    Dim arr1 As Variant, arr2 As Variant, arr3 As Variant, arr4 As Variant
    arr1 = Array(1, 3, 5, 5)
    arr2 = Array(4, 0, 9, 1)
    arr3 = Array(1, 2, 3, 4)
    arr4 = Array(4, 3, 2, 1)
    'result     10, 8, 19, 11

    Dim MultArr As Variant
    MultArr = Array(1, 1, 1, 1)  'a 1 for every arr variable that you sum (4 arrays = 4 ones)

    Dim ResultArr As Variant
    ResultArr = Application.WorksheetFunction.MMult(MultArr, Array(arr1, arr2, arr3, arr4))

    'just an output example:
    Debug.Print Join(ResultArr, ", ")
End Sub

Because of the matrix multiplication rules this is how it multiplies the matrix MultArr with the matrix that consists out of arr1 … arr4, which is the same result as adding arr1 … arr4:

Since in your question the 2-dimensional arrays ReDim R(1 To UBound(SR, 2), 1 To 1) are almost 1-dimensional, they can be reduced to a 1D array ReDim R(1 To UBound(SR, 2)) filled like R(iSR) = SR(5, iSR) and you can easily use that trick above to sum them:

.Range("B" & lastrow + 1 & ":" & "H" & lastrow + 1).Value = Application.WorksheetFunction.MMult(Array(1, 1, 1, 1), Array(R, M, O, Q))

Approach with a loop

As chris neilsen mentioned that the approach shown above is about 8 times slower then a loop, I suggest the following:

Since in your question the 2-dimensional arrays ReDim R(1 To UBound(SR, 2), 1 To 1) are almost 1-dimensional, they can be reduced to a 1D array which is easier to handle ReDim R(1 To UBound(SR, 2)) filled like R(iSR) = SR(5, iSR)

And you can sum them up by a loop

Dim RestultArr As Variant
ReDim ResultArr(1 To UBound(SR, 2))

Dim i As Long
For i = LBound(ResultArr) To UBound(ResultArr)
    ResultArr(i) = R(i) + M(i) + O(i) + Q(i)
Next i

And write it to your range

.Range("B" & lastrow + 1 & ":" & "H" & lastrow + 1).Value = ResultArr

edited Dec 4, 2018 at 8:07

answered Dec 3, 2018 at 14:40

Pᴇʜ

57.9k10 gold badges55 silver badges75 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

chris neilsen Over a year ago

While this seems an interesting approach, it's actually much slower than a simple For loop over the arrays - in this case by a factor of about 8

Pᴇʜ Over a year ago

@chrisneilsen Thank you for the warning. I didn't test it for speed (and I actually didn't expect it to be that slow). Nevertheless I added an approach for a loop, to complete the answer.

T.M. Over a year ago

Despite speed considerations: one of the most instructive MMult illustrations +1 :-)

Josh Eller · Accepted Answer · 2018-11-27 21:10:17Z

1

No, VBA does not support vector operations on arrays. You'll just need to loop through all the values in your arrays, add them together into a new output array, then set the value of your range to the new array.

answered Nov 27, 2018 at 21:10

Josh Eller

2,0859 silver badges11 bronze badges

3 Comments

excelguy Over a year ago

Should I just use the one variable to store my values, aka R ? then write it? Not sure if that works.

Josh Eller Over a year ago

Are you just trying to output a single value, or are you trying to output an array of values? If it's just a single value, then yes, just use one variable instead of an array of variables.

excelguy Over a year ago

I am trying to output values here, .Range("B" & lastrow + 1 & ":" & "H" & lastrow + 1).Value So about 7 values across this row, all should be different values though.

EEM · Accepted Answer · 2018-12-06 08:49:11Z

The original code posted in the question uses too many for…next and arrays, suggest to use the Match function to identify the field position and to sum the required values by field, before adding them to the array then post the resulting array.

Requirements as I understand the problem:

To add the values in row 5 from range D3:J7 and the values in rows 6, 7 & 8 from range D28:J35 in worksheet Sheet A as they correspond to the fields in range B1:H1 in worksheet Sheet B, using the first row of each range to identify the field position in relation to the range B1:H1 in worksheet Sheet B. Then to post the resulting values for each field in the first blank row below range B1:H1 in worksheet Sheet B.

The code below uses the worksheet function Match to identify the field positions in each range instead of looping through each range Then after finding the position of the field in each range, adds the corresponding values to the output array

Sample DATA before:

Sub TEST()
Dim aOutput As Variant
Dim aHdr As Variant, aSR As Variant, aOAS As Variant
Dim bHdr As Byte, bSR As Byte, bOAS As Byte
Dim lastrow

    lastrow = 1     'Value assigned for test purpose

    Rem Set Arrays
    With ThisWorkbook
        aSR = .Worksheets("Sheet A").Range("D3:J7").Value     ' Array for CS01 Data
        aOAS = .Worksheets("Sheet A").Range("D28:J35").Value  ' Array for MBS Data
        aHdr = Worksheets("Sheet B").Range("B1:H1").Value
    End With

    Rem Redimensioning Header Array
    aHdr = WorksheetFunction.Transpose(aHdr)
    aHdr = WorksheetFunction.Transpose(aHdr)

    Rem Create Output Array
    aOutput = aHdr

    Rem Fill Output Array
    For bHdr = 1 To UBound(aHdr)

        Rem Initiate Variables
        bSR = 0
        bOAS = 0
        aOutput(bHdr) = 0

        With WorksheetFunction

            Rem Get Field Position
            On Error Resume Next
            bSR = .Match(aHdr(bHdr), .Index(aSR, 1, 0), 0)
            bOAS = .Match(aHdr(bHdr), .Index(aOAS, 1, 0), 0)
            On Error GoTo 0

            Rem Add Field Values To Ouput Array
            If bSR <> 0 Then aOutput(bHdr) = aSR(5, bSR)
            If bOAS <> 0 Then aOutput(bHdr) = aOutput(bHdr) _
                + aOAS(6, bOAS) + aOAS(7, bOAS) + aOAS(8, bOAS)

    End With: Next

    Rem Post Ouput Array
    ThisWorkbook.Worksheets("Sheet B").Cells(1 + lastrow, 2) _
        .Resize(1, UBound(aOutput)).Value2 = aOutput

    End Sub

Result:

Therefore there is no need to add several arrays as only one array is created.

Note that in the original code these lines:

R(iSR, 1) = SR(5, iSR) 
M(iOAS, 1) = OAS(6, iOAS) 
O(iOAS, 1) = OAS(7, iOAS) 
Q(iOAS, 1) = OAS(8, iOAS)

Should have been:

R(iheaders, 1) = SR(5, iSR) 
M(iheaders, 1) = OAS(6, iOAS) 
O(iheaders, 1) = OAS(7, iOAS) 
Q(iheaders, 1) = OAS(8, iOAS)

T.M. · Accepted Answer · 2018-12-04 20:40:29Z

Another way leading to Rome ...

Just for the sake of the art and in addition to the valid solutions above, I demonstrate a method how to patch the wanted array portions together in a one liner (instead of creating multiple arrays) using the advanced filtering features of the Application.Index function (cf. section 1b).

The resulting new variant array v is written back to 'Sheet B' (cf. section 2).

Furthermore I show some examples to get column or row sums as well as totals (cf. section 3).

Code example

I assume the columns in the data blocks belong to identical categories.

Option Explicit         ' declaration head of your code module

Sub AddDataBlocks()
' [1a] create 2-dim data field array (1-based)
  Dim v
  v = ThisWorkbook.Worksheets("Sheet A").Range("D3:J35").Value2
' [1b] filter rows to be maintained (omitting title row)
  Dim MyRows(): MyRows = Array(5, 31, 32, 33)
  v = Application.Transpose(Application.Index(v, MyRows, Evaluate("row(1:" & UBound(v, 2) & ")")))

' [2]  write new array back to sheet B
  Dim lastrow&: lastrow = 1
  ThisWorkbook.Worksheets("Sheet B").Range("B" & lastrow + 1).Resize(UBound(v), UBound(v, 2)) = v

' ~~> Some arithmetics in examples
' [3a] get total sum
  Dim total#, i&, j&
  For i = LBound(v) To UBound(v)
      For j = LBound(v, 2) To UBound(v, 2)
          total = total + v(i, j)
      Next j
  Next i
  Debug.Print "Total = " & total
' [3b] display a row sum, e.g. 2nd row (no iM)
  Const iR = 1, iM = 2, iO = 3, iQ = 4
  Debug.Print "M = " & WorksheetFunction.Sum(Application.Transpose(Application.Index(v, iM, 0)))
' [3c] display a column sum, e.g. 3rd column
  Debug.Print "3rd column added = " & WorksheetFunction.Sum(Application.Transpose(Application.Index(v, 0, 3)))

End Sub

Collectives™ on Stack Overflow

Adding arrays together (in VBA) for output

4 Answers 4

Approach with matrix multiplication

Approach with a loop

3 Comments

3 Comments

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

Approach with matrix multiplication

Approach with a loop

3 Comments

3 Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related