0

My code runs trough dozens of excel documents, selects range and gives the range to an array. I would like to add up the arrays to get a summarized data then paste the result to an existing worksheet. The formula should be something like this:

rangeVar = oNewBook.Worksheets(1).Range("A1:D4").Value

sumRange = sumRange + rangeVar

Important! Some cells in the range is empty (I don't know is this matters). Also I would like to add up the values separately like sumRange(1,1)+rangeVar(1,1) ; sumRange(2,2)+rangeVar(2,2) , etc... How to do this? You can check the code here:

Sub LoopAllExcelFilesInFolder()

Dim OutputWs As Worksheet
Dim oNewBook As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim Lastrow As Long
Dim i As Integer, j As Integer
Dim summaryVar() As Variant
Dim rangeVar() As Variant

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension
  myExtension = "*.xlsx"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'set output worksheet
  Set OutputWs = ThisWorkbook.Worksheets("Teszt")

'Loop through each Excel file in folder
  Do While myFile <> ""

    Set oNewBook = Workbooks.Open(myPath & myFile)
    rangeVar = oNewBook.Worksheets(1).Range("A1:D4").Value
    oNewBook.Close

'Copy selected items
With OutputWs
    Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    OutputWs.Range("A" & Lastrow & ":" & "D" & Lastrow) = Application.WorksheetFunction.Sum(rangeVar)  'summaryVar
    Paste:=xlPasteAll, operation:=xlPasteSpecialOperationAdd, skipBlanks:=False
    Application.CutCopyMode = False
End With

'Get next file name
  myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub
  • What's wrong with `sumRange(1,1)=sumRange(1,1)+rangeVar(1,1)` ? –  Jun 14 '16 at 11:56
  • how do you loop that if the range is A1:K9 ? I would like to add up each cells in the same position, like you say cell(1,1) + otherRangeCell(1,1)... – Lóránt Csaba Mihály Jun 14 '16 at 12:05
  • I want to add something like this, but it ends up run-time error 9, subscript out of range: (I've changed the input and output range to A1 to J4) For i = 0 To 3 For j = 0 To 9 summaryVar() = summaryVar(i, j) + rangeVar(i, j) Next Next – Lóránt Csaba Mihály Jun 14 '16 at 12:19

2 Answers2

0

S. Meaden answers this question wonderfully in How to add arrays?. Instead of trying to add the two arrays together, he makes use of Excel's pasteSpecial Addvalues function to add the original range's values to another range. Based on his code, something like the below should work.

Set tempWS = Sheets.Add

Do While myFile <> ""

   Set oNewBook = Workbooks.Open(myPath & myFile)
   oNewBook.Worksheets(1).Range("A1:D4").Copy
   tempWS.Range("A1:D4").PasteSpecial   Paste:=xlPasteAll, operation:=xlPasteSpecialOperationAdd
   oNewBook.Close
Community
  • 1
  • 1
Yarnspinner
  • 852
  • 5
  • 7
0

Standard Excel Worksheet Functions will work on 1 and 2 dimensional arras.

Sub Test()
    Dim array2(25, 25) As Double
    Dim i As Integer, j As Integer
    For i = 0 To UBound(array2, 1)
        For j = 0 To UBound(array2, 1)
            array2(i, j) = Int((Rnd * 100) + 1)
        Next
    Next


    MsgBox WorksheetFunction.Sum(array2)
End Sub