Combine Data from two files in excel and do some calculation - excel

Question

The project consist to add lines in a new table based on value coming from 2 different table (or Excel file).
There are 3 files, called by :
Reference : the content of the file will not change
Data : the content of the file will always change
Result : the content of the file is a combination of the Reference and Date based on my request below. It is want I need.
I create 3 files, all manually with some value in order to help you to understand, called Example_Reference, Example_Data and Example_Result.
What as to be done:
First step:
Write a new line (in the new file/table) and copy exactly all the cells of the first line of Reference file.
Second step:
We take the content of the cell (column A) of Reference file (same line that point 1.) and we look in the Data file if one cell at least (column A) is the exactly the same :
a. If NOT : Do nothing, and continue for next line of the Reference file (do that until end of line of the Reference line (not end of Excel, but when no more line with something inside))
b. If YES :
i. Look how many line are with the same value (text) in the column A (Data file), create (in the Result file) a number of line equal to the number of same value and copy all data and line from Data file (for the same Column A of course).
ii. Modify in the first line (created on point 1) the cell (column R) with the different value of the column R added in point 2.b. of each line with specific “;” as in example. (T1;T2;T3… if T1 T2 and T3 are on the line).
iii. For main line (where a Product is written, like in the Reference file and line), on column N, it should be the sum of all the number below (0, 3 or 😎 for all the subline (Variant).
3. If sum = 0, write FALSE on column K. If sum is different from 0, write on column K TRUE.
c. Do that until we finish to read all the line of the Reference
Below are the Images of example three files:
Reference
Data
Result
So far I have done with the First Step as follows:
Dim cel As Range
Dim oFoundRng As Range
Range("A1").End(xlUp).Select ' looking for first empty cell on result sheet
With Workbooks("Example_Reference").Worksheets("Feuil1")
With .Range("a1", .Cells(.Rows.Count, "a").End(xlUp))
For Each cel In .SpecialCells(xlCellTypeConstants) ' loop through referenced range not empty cells
.Range(cel.Address).EntireRow.Copy Workbooks("result").Worksheets("feuil1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next
End With
End With
Now I need to take the content of the cell (column A) of Reference file (same line that point 1.) and we look in the Data file if one cell at least (column A) is the exactly the same.
can you guys help?
I will update my question as I go along ...

Answer 1

Here you have, let me know if works as you expected :)
Just set the workbook variables with your names or paths.
The sub is ready to work with the three workboos already opened but if
you want the macro to open the wbks just add workbooks.open method at the beginning.
Sub ProcessData()
'Workbook ans worksheet declaration
Dim referenceWbk As Workbook
Set referenceWbk = Workbooks("Reference.xlsx")
Dim dataWbk As Workbook
Set dataWbk = Workbooks("Data.xlsx")
Dim exampleWbk As Workbook
Set exampleWbk = Workbooks("Example.xlsm")
Dim referenceWsh As Worksheet
Set referenceWsh = referenceWbk.Sheets(1)
Dim dataWsh As Worksheet
Set dataWsh = dataWbk.Sheets(1)
Dim exampleWsh As Worksheet
Set exampleWsh = exampleWbk.Sheets(1)
'Loop reference workbook
Dim exampleLastRow As Long: exampleLastRow = 1
Dim i As Long
For i = 1 To referenceWsh.Range("A" & referenceWsh.Rows.Count).End(xlUp).Row
referenceWsh.Range("A" & i).EntireRow.Copy
exampleWsh.Range("A" & exampleLastRow).PasteSpecial xlPasteValues
'loop data wsh
Dim coicidenceCount As Long: coicidenceCount = 0
'Delete header in column N, R and K
exampleWsh.Range("N" & exampleLastRow).Value = ""
exampleWsh.Range("R" & exampleLastRow).Value = ""
exampleWsh.Range("K" & exampleLastRow).Value = ""
Dim j As Long
For j = 1 To dataWsh.Range("A" & dataWsh.Rows.Count).End(xlUp).Row
If dataWsh.Range("A" & j).Value = exampleWsh.Range("A" & exampleLastRow).Value Then
coicidenceCount = coicidenceCount + 1
exampleWsh.Range("A" & exampleLastRow + coicidenceCount).Value = dataWsh.Range("A" & j).Value
exampleWsh.Range("R" & exampleLastRow + coicidenceCount).Value = dataWsh.Range("B" & j).Value
exampleWsh.Range("N" & exampleLastRow + coicidenceCount).Value = dataWsh.Range("C" & j).Value
exampleWsh.Range("B" & exampleLastRow + coicidenceCount).Value = "Variant"
'add value to R header (plus ';')
exampleWsh.Range("R" & exampleLastRow).Value = exampleWsh.Range("R" & exampleLastRow).Value & dataWsh.Range("B" & j).Value & ";"
'add value to N header
exampleWsh.Range("N" & exampleLastRow).Value = exampleWsh.Range("N" & exampleLastRow).Value + dataWsh.Range("C" & j).Value
End If
Next j
'add value to K header
If exampleWsh.Range("N" & exampleLastRow).Value > 0 Then
exampleWsh.Range("K" & exampleLastRow).Value = True
Else
exampleWsh.Range("K" & exampleLastRow).Value = False
End If
'delete last ';' from R header
If exampleWsh.Range("R" & exampleLastRow).Value <> "" Then
exampleWsh.Range("R" & exampleLastRow).Value = Left(exampleWsh.Range("R" & exampleLastRow).Value, Len(exampleWsh.Range("R" & exampleLastRow).Value) - 1)
End If
exampleLastRow = exampleWsh.Range("A" & exampleWsh.Rows.Count).End(xlUp).Row + 1
Next i
End Sub

Answer 2

Try the next code, please. We cannot see which is the last column of 'Reference' sheet, but looking to the 'Result' one I assumed that it should be column "Q:Q":
Sub testProcessThreeWorkbooks()
Dim wsRef As Worksheet, wsData As Worksheet, wsRes As Worksheet
Dim lastRR As Long, lastRD As Long, rowRes As Long, i As Long, j As Long
Dim count As Long, k As Long, arr, arrT
Set wsRef = Workbooks("Example_Reference.xlsx").Sheets(1) 'use here the necessary sheet
Set wsData = Workbooks("Example_Data.xlsx").Sheets(1) 'use here the necessary sheet
Set wsRes = Workbooks("Example_Result.xlsx").Sheets(1) 'use here the necessary sheet
lastRR = wsRef.Range("A" & rows.count).End(xlUp).row 'last row of 'Reference` sheet
lastRD = wsData.Range("A" & rows.count).End(xlUp).row 'last row of 'Data' sheet
rowRes = 1 'Row of the 'Result' sheet, where the first processed line should be placed
For i = 1 To lastRR 'iterate between all existing cells of A:A 'Reference' sheet column
wsRes.Range("A" & rowRes).Resize(1, 17).Value = wsRef.Range("A" & i, "Q" & i).Value 'copy the row to be processed
count = WorksheetFunction.CountIf(wsData.Range("A1:A" & lastRD), wsRef.Range("A" & i).Value) 'count the occurrences
If count > 0 Then 'if any occurence exists:
ReDim arrT(count - 1) 'redim the array keeping 'T' type data
ReDim arr(count - 1) 'redim the array to keep the values from C:C column
k = 0 'initialize the variable to fill in the above arrays
For j = 1 To lastRD 'iterate between all existing cells of A:A 'Data' sheet column
If wsRef.Range("A" & i).Value = wsData.Range("A" & j).Value Then 'for occurrences:
arrT(k) = wsData.Range("B" & j).Value 'load 'T' type values
arr(k) = wsData.Range("C" & j).Value: k = k + 1 'Load values of C:C column
End If
Next j
With wsRes 'process the 'Result' range:
.Range("R" & rowRes).Value = Join(arrT, ";") 'place the string in column R:R
.Range("A" & rowRes + 1 & ":A" & rowRes + count).Value = wsRef.Range("A" & i).Value 'copy the 'Codes'
.Range("B" & rowRes + 1 & ":B" & rowRes + count).Value = "Variant" 'write 'Variant'
.Range("N" & rowRes + 1).Resize(UBound(arr) + 1, 1).Value = WorksheetFunction.Transpose(arr) 'drop the array values
.Range("N" & rowRes).Formula = "=Sum(N" & rowRes + 1 & ":N" & rowRes + count & ")" 'sumarize the values of N:N col
'Evaluate the value in N:N and place 'TRUE' or 'FALSE' accordingly:
If .Range("N" & rowRes).Value = 0 Then .Range("K" & rowRes).Value = False Else: .Range("K" & rowRes).Value = True
End With
End If
rowRes = rowRes + count + 1: count = 0 'reinitialize the necessary variables
Next i
End Sub
If big files/ranges are involved, I can prepare a faster solution using arrays instead of all ranges.
Edited
I found some time and prepared the faster version, using only arrays, all processing being done in memory:
Sub testProcessThreeWorkbooksArrays()
Dim wsRef As Worksheet, wsData As Worksheet, wsRes As Worksheet
Dim lastRR As Long, lastRD As Long, rowRes As Long, i As Long, j As Long
Dim count As Long, k As Long, arrRef, arrDat, arrRes, arrSlice, arr, arrT
Dim m As Long, sumV As Double
Set wsRef = Workbooks("Example_Reference.xlsx").Sheets(1) 'use here the necessary sheet
Set wsData = Workbooks("Example_Data.xlsx").Sheets(1) 'use here the necessary sheet
Set wsRes = Workbooks("Example_Result.xlsx").Sheets(1) 'use here the necessary sheet
lastRR = wsRef.Range("A" & rows.count).End(xlUp).row 'last row of 'Reference` sheet
lastRD = wsData.Range("A" & rows.count).End(xlUp).row 'last row of 'Data' sheet
arrRef = wsRef.Range("A1:Q" & lastRR).Value
arrDat = wsData.Range("A1:C" & lastRD).Value
ReDim arrRes(1 To 18, 1 To UBound(arrRef) + UBound(arrDat))
rowRes = 1 'Row of the 'Result' sheet, where the new processed line should be placed
For i = 1 To UBound(arrRef) 'iterate between all existing 'arrRef' array rows
arrSlice = Application.Index(arrRef, i, 0) 'extract a slice of the row number i
'Place the slice values in the arrRes appropriate row:
For m = 1 To UBound(arrSlice): arrRes(m, rowRes) = arrSlice(m): Next m
arrSlice = Application.Index(arrDat, 0, 1) 'extract a slice of the 'arrDat' first column
For m = 1 To UBound(arrSlice)
If arrSlice(m, 1) = arrRef(i, 1) Then count = count + 1 'extract number of occurrences
Next m
If count > 0 Then 'if any occurence exists:
ReDim arrT(count - 1) 'redim the array keeping 'T' type data
ReDim arr(count - 1) 'redim the array to keep the values from C:C column
k = 0 'initialize the variable to fill in the above arrays
For j = 1 To UBound(arrDat) 'iterate between all 'arrDat' array rows:
If arrRef(i, 1) = arrDat(j, 1) Then 'in case of occurrences:
arrT(k) = arrDat(j, 2) 'load 'T' type values
arr(k) = arrDat(j, 3): k = k + 1 'Load values of C:C column
End If
Next j
arrRes(18, rowRes) = Join(arrT, ";") 'place the string in column R:R
For m = rowRes + 1 To rowRes + count
'place the code ("A:A" content) and "Variant" string:
arrRes(1, m) = arrRef(i, 1): arrRes(2, m) = "Variant"
Next m
For m = 0 To UBound(arr) 'place the values in the 14th column
arrRes(14, rowRes + m + 1) = arr(m)
sumV = sumV + arr(m) 'calculate the values Sum
Next m
arrRes(14, rowRes) = sumV 'place the Sum in the 14th array column
If sumV > 0 Then arrRes(11, rowRes) = True Else: arrRes(11, rowRes) = False 'True/False
End If
rowRes = rowRes + count + 1: count = 0: sumV = 0 'reinitialize the necessary variables
Next i
ReDim Preserve arrRes(1 To 18, 1 To rowRes - 1) 'keep only the non empty array elements
wsRes.Range("A1").Resize(UBound(arrRes, 2), UBound(arrRes)).Value = Application.Transpose(arrRes)
MsgBox "Ready..."
End Sub
Please, test it and send some feedback.

Answer 3

Edited: lol you changed your question.. ;)
If you like make everything with "Select" then:
Sub Macro1()
Set ref = Workbooks("book1").Sheets("sheet1")
Set res = Workbooks("book2").Sheets("sheet2")
ref.Rows("6:6").Copy
res.Activate
res.Rows("9:9").Select
ActiveSheet.Paste
End Sub
But you should avoid using select if you will have a lot of data, as its perfomance is slow as hell.