Matching data from two sources and simple calculations in excel - excel

Question

I have some calculations I need to do on a data-set. The calculations are simple (i.e input 1 x input 2 = output), but they take inputs recorded in two different excel workbooks by different people. Due to the different input sources the parameters between the two are sometimes in different orders or with slightly different names - the picture attached should show what I mean.
My plan was to take the relevant sheet of input book 1, and the relevant sheet of input book 2, and copy them into a single workbook where i hope to match the parameters with some sort of lookup/find macro, and perform the calculations automatically using a loop to work across the headers and down the rows
combined worksheet concept
Would really appreciate any help.

Answer 1

Even if you look less interested than me to solve this problem, I prepared the next code with the assumption that the array obtained from the the string "apple,banana,orange,grape" covers both sheets strange style head of columns naming.
I used "X1" for your first sheet name, "X2" for the second one and "Result" for the one matching values of the first two:
Sub MatchingLike_bis()
Dim arrNames As Variant, sh1 As Worksheet, sh2 As Worksheet, sRez As Worksheet
Dim lastR1 As Long, lastR2 As Long, arrRez As Variant, arr1 As Variant, arr2 As Variant
Dim i1 As Long, i2 As Long, El As Variant, k As Long, col1 As Long, col2 As Long
Dim strProbl1 As String, strProbl2 As String, colTot As Long, boolF As Boolean, i As Long
arrNames = Split("apple,banana,orange,grape,lemon", ",")
colTot = UBound(arrNames) + 2 'The array is zero based and A is excepted
Set sh1 = ThisWorkbook.Sheets("X1")
Set sh2 = ThisWorkbook.Sheets("X2")
Set sRez = ThisWorkbook.Sheets("Result")
lastR1 = sh1.Range("A" & sh1.Rows.count).End(xlUp).Row
lastR2 = sh2.Range("A" & sh2.Rows.count).End(xlUp).Row
arr1 = sh1.Range(sh1.Cells(1, 1), sh1.Cells(lastR1, colTot)).Value
arr2 = sh2.Range(sh2.Cells(1, 1), sh2.Cells(lastR1, colTot)).Value
'preliminary check if all fruits name has a corespondent in both necessary sheets:__________
strProbl1 = "": strProbl2 = ""
For Each El In arrNames
For i1 = 2 To colTot 'make checking in first sheet
If InStr(UCase(arr1(1, i1)), UCase(El)) > 0 Then
boolF = True: Exit For
End If
Next i1
If Not boolF Then strProbl1 = strProbl1 & El & vbCrLf
boolF = False
For i2 = 2 To colTot 'make checking in the second sheet
If InStr(UCase(arr2(1, i2)), UCase(El)) > 0 Then
boolF = True: Exit For
End If
Next i2
If Not boolF Then strProbl2 = strProbl2 & El & vbCrLf
boolF = False
Next
If strProbl1 <> "" Then MsgBox "In " & sh1.Name & " sheet, the next fruit names are" & _
" incorrect, or missing:" & vbCrLf & _
vbCrLf & strProbl1 & vbCrLf & "Please correct the spelling and run the application again!", _
vbInformation, "Wrong spelling in " & sh1.Name & " worksheet": sh1.Activate: Exit Sub
If strProbl2 <> "" Then MsgBox "In " & sh2.Name & " sheet, the next fruit names are" & _
" incorrect, or missing:" & vbCrLf & _
vbCrLf & strProbl2 & vbCrLf & "Please correct the spelling and run the application again!", _
vbInformation, "Wrong spelling in " & sh2.Name & " worksheet": sh2.Activate: Exit Sub
'_________________________________________________________________________________________________
ReDim arrRez(1 To UBound(arr1, 1), 1 To colTot) 'result array will have exactly the
'number of rows and columns as arr1
For i1 = 1 To UBound(arr1, 1)
If i1 = 1 Then
arrRez(i1, 1) = Empty
For i = 2 To colTot
arrRez(i1, i) = arr1(i1, i)
Next i
Else
For i2 = 1 To UBound(arr2, 1)
If arr1(i1, 1) = arr2(i2, 1) Then
arrRez(i1, 1) = arr1(i1, 1)
'find the right reference in the accepted keys array:
For Each El In arrNames
For k = 2 To colTot
If InStr(UCase(arr1(1, k)), UCase(El)) > 0 Then col1 = k
If InStr(UCase(arr2(1, k)), UCase(El)) > 0 Then col2 = k
Next k
If col1 > 0 And col2 > 0 Then
arrRez(i1, col1) = arr1(i1, col1) + arr2(i2, col2)
col1 = 0: col2 = 0
End If
Next
End If
Next i2
End If
Next i1
With sRez.Range(sRez.Range("A1"), sRez.Cells(lastR1, colTot))
.Value = arrRez
.EntireColumn.AutoFit
End With
End Sub
This version allows adding of a new fruit name in the string "apple,banana,orange,grape,lemon" (I already added lemon) and the code adapts itself to return as many columns as necessary. It makes a preliminary check and sends relevant messages for fruit names wrongly spelled in both input sheets. The code will completely run only if all the fruit names are matched in both input sheets...