combined the same sheet name between two files & save as xlsx

[Maklil]

Hi experts,
I search for macro to combine the same sheet name between two files are in the same folder . so should combine based on match column B and summing values for columns C,D and insert column BALANCE in column E to subtract column C from column D and save the file as xlsx and the file name should be "FINAL STOCK" and sheet name should be "STOCK" based on sheet name into two files .
the sheet STOCK into two files is existed in last sheet .

STOCK.xlsx
	A	B	C	D
1	ITEM	BRAND	IMPORT	EXPORT
2	1	ELEC-1000	200
3	2	ELEC-1001	1200
4	3	ELEC-1002		122
5	4	ELEC-1003	1200
6	5	ELEC-1004	120
7	6	ELEC-1005	300
8	7	ELEC-1006	230
9	8	ELEC-1007	123
10	9	ELEC-1008	123
11	10	ELEC-1009	123
12	11	ELEC-1010	1122
13	12	ELEC-1011	122	10
14	13	ELEC-1012		4
15	14	ELEC-1013	123
16	15	ELEC-1014	123	1
17	16	ELEC-1015	11
18	17	ELEC-1016	11
19	18	ELEC-1017	12
20	19	ELEC-1018	12
21	20	ELEC-1019	10	12
stock

STO.xlsx
	A	B	C	D
1	ITEM	BRAND	IMPORT	EXPORT
2	1	ELEC-1012	123
3	2	ELEC-1013	10	10
4	3	ELEC-1022	20	12
5	4	ELEC-1009	11
6	5	ELEC-1010	10
7	6	ELEC-1011	12
8	7	ELEC-1003	220
9	8	ELEC-1004		4
10	9	ELEC-1005	100
11	10	ELEC-1006	10
12	11	ELEC-1007	10
13	12	ELEC-1008	10
14	13	ELEC-1000	10
15	14	ELEC-1001	10
16	15	ELEC-1002		22
17	16	ELEC-1014	11	2
18	17	ELEC-1015	112
19	18	ELEC-1016	120
20	19	ELEC-1017	10	2
stock

result (should be the same formatting & borders)

FINAL STOCK.xlsx
	A	B	C	D	E
1	ITEM	BRAND	IMPORT	EXPORT	BALANCE
2	1	ELEC-1000	210.00	-	210.00
3	2	ELEC-1001	1,210.00	-	1,210.00
4	3	ELEC-1002	-	144.00	-144.00
5	4	ELEC-1003	1,420.00	-	1,420.00
6	5	ELEC-1004	120.00	4.00	116.00
7	6	ELEC-1005	400.00	-	400.00
8	7	ELEC-1006	240.00	-	240.00
9	8	ELEC-1007	133.00	-	133.00
10	9	ELEC-1008	133.00	-	133.00
11	10	ELEC-1009	134.00	-	134.00
12	11	ELEC-1010	1,132.00	-	1,132.00
13	12	ELEC-1011	134.00	10.00	124.00
14	13	ELEC-1012	123.00	4.00	119.00
15	14	ELEC-1013	133.00	10.00	123.00
16	15	ELEC-1014	134.00	3.00	131.00
17	16	ELEC-1015	123.00	-	123.00
18	17	ELEC-1016	131.00	-	131.00
19	18	ELEC-1017	22.00	2.00	20.00
20	19	ELEC-1018	12.00	-	12.00
21	20	ELEC-1019	10.00	12.00	-2.00
22	21	ELEC-1022	20.00	12.00	8.00
STOCK

thanks

 

[Maklil]

here is the whole files

FINAL STOCK.xlsm
STO.xlsx
STOCK.xlsx

 

[mumps]

Try:

Sub CombineData()
    Application.ScreenUpdating = False
    Dim ws1 As Worksheet, ws2 As Worksheet, wb1 As Workbook, wb2 As Workbook, desWB As Workbook, desWS As Worksheet
    Dim v1 As Variant, v2 As Variant, i As Long, srcRng As Range, lRow As Long, fnd As Range
    Set desWB = ThisWorkbook
    Set desWS = ThisWorkbook.Sheets("Stock")
    desWS.UsedRange.Offset(1).ClearContents
    Set wb1 = Workbooks.Open("C:\Test\STOCK.xlsx")
    Set ws1 = Sheets("Stock")
    Set wb2 = Workbooks.Open("C:\Test\STO.xlsx")
    Set ws2 = Sheets("Stock")
    v1 = ws1.Range("B2", ws1.Range("B" & Rows.Count).End(xlUp)).Resize(, 3).Value
    v2 = ws2.Range("B2", ws2.Range("B" & Rows.Count).End(xlUp)).Resize(, 3).Value
    Set srcRng = ws2.Range("B2", ws2.Range("B" & Rows.Count).End(xlUp))
    For i = LBound(v1) To UBound(v1)
        If Not IsError(Application.Match(v1(i, 1), srcRng, 0)) Then
            x = Application.Match(v1(i, 1), srcRng, 0)
            With desWS
                lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                .Range("B" & lRow).Resize(, 3).Value = Array(v1(i, 1), v1(i, 2) + ws2.Range("C" & x + 1), v1(i, 3) + ws2.Range("D" & x + 1))
                .Range("E" & lRow) = .Range("C" & lRow) - .Range("D" & lRow)
            End With
        Else
            With desWS
                lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                .Range("B" & lRow).Resize(, 3).Value = Array(v1(i, 1), v1(i, 2), v1(i, 3))
                .Range("E" & lRow) = .Range("C" & lRow) - .Range("D" & lRow)
            End With
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        Set fnd = desWS.Range("B:B").Find(v2(i, 1), LookIn:=xlValues, lookat:=xlWhole)
        If fnd Is Nothing Then
            With desWS
                lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                .Range("B" & lRow).Resize(, 3).Value = Array(v2(i, 1), v2(i, 2), v2(i, 3))
                .Range("E" & lRow) = .Range("C" & lRow) - .Range("D" & lRow)
            End With
        End If
    Next i
    With desWS
        .Range("A2").Value = "1"
        .Range("A2").AutoFill Destination:=.Range("A2").Resize(.Range("B" & .Rows.Count).End(xlUp).Row - 1), Type:=xlFillSeries
    End With
    Application.DisplayAlerts = False
    desWB.SaveAs Filename:=desWB.Path & Application.PathSeparator & "Final Stock.xlsx", FileFormat:=51
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[Maklil]

great !

I have two things .

first of all I want close two files after pull the data from them

second can I make the code flexible if I have many files with the same structure in the same folder instead of specify two files as in code.

 

[mumps]

Are you saying that you want to combine the data from more than 2 files? If so, upload one or two more files.

 

[Maklil]

is it important to upload another files?
the same thing . the same structure data without any different .

 

[mumps]

Working with more than two files will be different from working with only two files. An extra file will allow me to test the changes that need to be made to the macro.

 

[alansidman]

An alternative is with Power Query. Bring both tables into the Power Query Editor and then the following Mcode

let
    Source = Table.Combine({Table1, Table2}),
    #"Grouped Rows" = Table.Group(Source, {"BRAND"}, {{"Total Import", each List.Sum([IMPORT]), type nullable number}, {"Total Export", each List.Sum([EXPORT]), type nullable number}}),
    #"Replaced Value" = Table.ReplaceValue(#"Grouped Rows",null,0,Replacer.ReplaceValue,{"Total Import","Total Export"}),
    #"Inserted Subtraction" = Table.AddColumn(#"Replaced Value", "Subtraction", each [Total Import] - [Total Export], type number),
    #"Renamed Columns" = Table.RenameColumns(#"Inserted Subtraction",{{"Subtraction", "Net"}})
in
    #"Renamed Columns"

 

[Maklil]

@mumps
another files
STR.xlsx
STRN.xlsx

 

[mumps]

Change the folder path (in red) to suit your needs.

Sub CombineData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, srcWB As Workbook, desWB As Workbook, desWS As Worksheet
    Dim v As Variant, i As Long, srcRng As Range, lRow As Long, fnd As Range
    Set desWB = ThisWorkbook
    Set desWS = ThisWorkbook.Sheets("Stock")
    desWS.UsedRange.Offset(1).ClearContents
    Const strPath As String = "C:\Test\"
    ChDir strPath
    strextension = Dir(strPath & "*.xlsx")
    Do While strextension <> ""
        Set srcWB = Workbooks.Open(strPath & strextension)
        If srcWB.Name <> "Final Stock.xlsx" Then
            Set srcWS = Sheets("Stock")
            v = srcWS.Range("B2", srcWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 3).Value
            For i = LBound(v) To UBound(v)
                Set srcRng = desWS.Range("B2", desWS.Range("B" & Rows.Count).End(xlUp))
                If Not IsError(Application.Match(v(i, 1), srcRng, 0)) Then
                    x = Application.Match(v(i, 1), srcRng, 0)
                    With desWS
                        .Range("C" & x + 1) = .Range("C" & x + 1) + v(i, 2)
                        .Range("D" & x + 1) = .Range("D" & x + 1) + v(i, 3)
                        .Range("E" & x + 1) = .Range("C" & x + 1) - .Range("D" & x + 1)
                    End With
                Else
                    With desWS
                        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                        .Range("B" & lRow).Resize(, 3).Value = Array(v(i, 1), v(i, 2), v(i, 3))
                        .Range("E" & lRow) = .Range("C" & lRow) - .Range("D" & lRow)
                    End With
                End If
            Next i
        End If
        srcWB.Close False
        strextension = Dir
    Loop
    With desWS
        .Range("A2").Value = "1"
        .Range("A2").AutoFill Destination:=.Range("A2").Resize(.Range("B" & .Rows.Count).End(xlUp).Row - 1), Type:=xlFillSeries
    End With
    Application.DisplayAlerts = False
    desWB.SaveAs Filename:=desWB.Path & Application.PathSeparator & "Final Stock.xlsx", FileFormat:=51
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[Maklil]

great ! can you sort from small to big ELEC-1000 ,ELEC-1002,ELEC-1003 ....?