Subtraction of two multidimensional Arrays VBA - arrays

Question

I have a problem with a selfmade vba-code. The makro should solve the following problem: I use a "cockpitfile" It should load the elemts of two worksheets from two different Excel files into two Arrays. The Elements of these Arrays should be subtracted from each other. I want to get the difference from these two elements. As an example: ArrayElm1(1,1) - ArrayElm2(1,1) = ArrayElm3(1,1), ArrayElm1(1,2) - ArrayElm2(1,2) = ArrayElm3(1,2) etc.
On the first sight the code seems to work but when I check the results with my calculater the difference of the elements is wrong. Maybe there is a problem with the UBound because in my Ubound is only Array A?
Hope you can help me!
Sub Differenz1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Variabledefinition
Dim i As Long 'Index
Dim j As Long 'Index
Dim k As Long 'Index
Dim ArrayA As Variant 'Array
Dim ArrayB As Variant 'Array
Dim ArrayC(71, 25) As Variant 'Array
Dim myFile1 As String 'Workbookname
Dim myFile2 As String 'Workbookname
Dim wb1 As String 'Workbookname
Dim wb2 As String 'Workbookname
Dim WS_Count1 As Integer 'Count Worksheets
Dim WS_Count2 As Integer 'Count Worksheets
Dim arrays1 As String 'Dimension
Dim arrays2 As String 'Dimension
'Change the actual path
ChDrive "O:\"
ChDir "O:..."
myFile1 = Application.GetOpenFilename
Workbooks.Open Filename:=myFile1, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
wb1 = ActiveWorkbook.Name
WS_Count1 = ActiveWorkbook.Worksheets.Count
myFile2 = Application.GetOpenFilename
Workbooks.Open Filename:=myFile2, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
wb2 = ActiveWorkbook.Name
WS_Count2 = ActiveWorkbook.Worksheets.Count
For k = 1 To WS_Count1
ArrayA = Workbooks(wb1).Worksheets(k).Range("F5:Y75").Value
ArrayB = Workbooks(wb2).Worksheets(k).Range("F5:Y75").Value
For i = LBound(ArrayA, 1) To UBound(ArrayA, 1)
For j = LBound(ArrayA, 2) To UBound(ArrayA, 2)
If Not IsError(ArrayA(i, j)) And Not IsError(ArrayB(i, j)) Then ArrayC(i, j) = ArrayA(i, j) - ArrayB(i, j)
Next j
Next i
ThisWorkbook.Worksheets(k + 1).Range("F5:Y75").Value = ArrayC
Next k
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

You almost had it right, but the issues was that you didn't reset ArrayC
This code creates new sheets in ThisWorkbook for subtractions, and based on your previous question it checks for errors, and performs the subtractions only if both values are numbers
Option Explicit
Public Sub Differenz2()
Const USED_RNG = "F5:Y75" 'Main range
Dim i As Long, j As Long, k As Long, file1 As String, file2 As String, ws1Count As Long
Dim wb1 As Workbook, wb2 As Workbook, arr1 As Variant, arr2 As Variant, arr3 As Variant
'ChDrive "O:\": ChDir "O:..."
file1 = Application.GetOpenFilename: If file1 = "False" Then Exit Sub
file2 = Application.GetOpenFilename: If file2 = "False" Then Exit Sub
Application.ScreenUpdating = False
Set wb1 = Workbooks.Open(Filename:=file1, ReadOnly:=True)
Set wb2 = Workbooks.Open(Filename:=file2, ReadOnly:=True)
ws1Count = wb1.Worksheets.Count
If ws1Count = wb2.Worksheets.Count Then
MakeNewWS ws1Count 'Remove this line if ThisWorkbook is properly setup
For k = 1 To ws1Count
arr1 = wb1.Worksheets(k).Range(USED_RNG).Value
arr2 = wb2.Worksheets(k).Range(USED_RNG).Value
ReDim arr3(1 To 71, 1 To 20) 'reset array, based on USED_RNG ("F5:Y75")
For i = LBound(arr1, 1) To UBound(arr1, 1)
For j = LBound(arr1, 2) To UBound(arr1, 2)
If Not IsError(arr1(i, j)) And Not IsError(arr2(i, j)) Then
If IsNumeric(arr1(i, j)) And IsNumeric(arr2(i, j)) Then
arr3(i, j) = arr1(i, j) - arr2(i, j)
End If
End If
Next
Next
ThisWorkbook.Worksheets(k + 1).Range(USED_RNG) = arr3
Next
End If
wb1.Close False: wb2.Close False: ThisWorkbook.Worksheets(2).Activate
Application.ScreenUpdating = True
End Sub
Private Sub MakeNewWS(ByVal wsCount As Long)
Dim i As Long, ws As Worksheet
With ThisWorkbook.Worksheets
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If Left(ws.Name, 12) = "Subtraction " Then
If .Count = 1 Then .Add
ws.Delete
End If
Next
Application.DisplayAlerts = True
For i = 2 To wsCount + 1
.Add After:=ThisWorkbook.Worksheets(.Count)
ThisWorkbook.Worksheets(.Count).Name = "Subtraction " & i - 1
Next
End With
End Sub
You can ignore the MakeNewWS() sub if ThisWorkbook contains the proper number of sheets
Also, using arrays does improve performance (significantly)