collection monthly report for multiple files into one

[abdo meghari]

hi experts !
I have report publish every month throught the year. what i want collect the all of the files into one . so the result in file collection shows each sheet for each file and rename for each sheet based on file name because all of the sheets names are the same in all of the files . the location of columns are different in orginal file so I want to arrange location of the columns as in file collection . after this should create the sheet is name YEAR , then should combined the data of all sheets into one sheet YEAR and summing the values for duplicates items for columns sales & returns.
note I want create the file every time when run the macro in the same folder contains the files .
thanks

[Richard Buttrey]

Stating the obvious but why do you collect the original data in individual monthly files, and where does the information come from?
Are these monthly files created manually or do they result from an output from some back office system?

Unless there's some overriding reason why the DATA is kept separately you should always collect it in a single table. It's far easier to extract /analyse information FROM a database than to combine files in order to analyse them.

If you are willing / able to create a composite file from now on then being pragmatic it would be simpler to just copy all 12 files and paste into a single workbook and sheet with an additional column to record the month for EACH record.

[abdo meghari]

Stating the obvious but why do you collect the original data in individual monthly files

this is sent by another company

where does the information come from?

any main reason to ask it?
the result in file collection depends on the others files . so I don't see your question is obstical for achieve it .

why the DATA is kept separately you should always collect it in a single table

as I said the reports are sent by another company for each month

If you are willing / able to create a composite file from now on then being pragmatic it would be simpler to just copy all 12 files and paste into a single workbook and sheet with an additional column to record the month for EACH record.

this is manual , not good idea . it takes much time

[Richard Buttrey]

this is sent by another company

any main reason to ask it?
the result in file collection depends on the others files . so I don't see your question is obstical for achieve it .

as I said the reports are sent by another company for each month

this is manual , not good idea . it takes much time

Why, when you receive each file, don't you simply copy and paste the data on the next row underneath the previous month's data. One way or another you are going to need to combine them in some way.
Why start with a problem.
A simple macro could prompt you to select a file and the data in it could be copied into the collective workbook automatically.

I prefer to do things in simple ways rather than make life more difficult.

[Marc L]

According to the attachment an Excel basics VBA demonstration for starters
to paste only to the ThisWorkbook module of the collection workbook :

Sub Demo1()
    Dim F$, S$, V, L&, W, R&, B$(1 To 65536, 0), T@(1 To 65536, 1)
        F = Dir$(Path & "\" & "*.xlsx"):  If F = "" Then Beep: Exit Sub
        If Not ActiveWorkbook Is Me Then Activate
    With Worksheet____4
       .Activate
       .[A2:D2].ClearContents
       .UsedRange.Offset(2).EntireRow.Delete
       .[B2].Value2 = "Wait …"
        Application.ScreenUpdating = False
       .[B2].ClearContents
    Do
        S = Split(F, ".")(0)
        If Evaluate("ISREF('" & S & "'!A1)") Then Sheets(S).UsedRange.Offset(1).EntireRow.Delete _
                                             Else .Copy Sheets(.Name): ActiveSheet.Name = S
    With Workbooks.Open(Path & "\" & F, 0).ActiveSheet.[A1].CurrentRegion.Rows
        .Item("3:" & .Count).AdvancedFilter 2, , Sheets(S).UsedRange.Rows(1)
        .Parent.Parent.Close False
    End With
        V = Sheets(S).UsedRange.Columns("B:D").Value2
    For L = 2 To UBound(V)
        W = Application.Match(V(L, 1), B, 0)
        If IsError(W) Then R = R + 1: B(R, 0) = V(L, 1): W = R
        T(W, 0) = T(W, 0) + V(L, 2)
        T(W, 1) = T(W, 1) + V(L, 3)
    Next
        F = Dir$
    Loop Until F = ""
    If R Then
        With .[A2:D2].Resize(R).Columns
             .Rows(1).Copy .Rows
             .Item(1).Value2 = Evaluate("ROW(1:" & R & ")")
             .Item(2).Value2 = B
             .Item("C:D").Value2 = T
             .Item("B:D").Sort .Item(2), 1, Header:=2
        End With
    End If
       .Activate
    End With
        Application.ScreenUpdating = True
End Sub 

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

[abdo meghari]

Why start with a problem.

nobody likes to make hard the matters for himself, but what if the data are huge. do you think still use manual way is practical ?

[Richard Buttrey]

nobody likes to make hard the matters for himself, but what if the data are huge. do you think still use manual way is practical ?

The size of the data is irrelevant.
Why do you assume I was suggesting a manual process? I explicitly said you could use a macro to pick a file and have the macro load it to a master database, in the process ordering it however you wished.

I still maintain a single database on a single sheet is far more elegant and efficient.

[abdo meghari]

@Marc L thanks for code, but it doesn't seem to work correctly . it just brings the first file and shows mismatch error in this line

T(W, 0) = T(W, 0) + V(L, 2)

[Sintek]

Check out V(L, 2) value...Is Item...hence error...
Perhaps...

V = Sheets(S).UsedRange.Columns("A:D").Value2

Then rest of code to be amended...?

[Marc L]

As I wrote « according to your attachment » it works like a charm on my side without such issue (no sense to post a non working code !)
so you did not try obviously on the same attachment ?!

If not that means there is non numeric data so you must check the data before to operate the sum within the T array …

[abdo meghari]

no way ! the same files ,the same data , may you check the result with the same files ,please?

[Marc L]

no way ! the same files ,the same data , may you check the result with the same files ,please?

Your bad as this is obviously not the same attachment ‼
In particular the collection workbook so try with your initial post attachment
with the Worksheet____4 (YEAR) worksheet as it is (at least rows #1 & 2) …

[Sintek]

Here's another option...
Change Path to Path housing files...

Sub J3v16()
Dim Temp, Dict As Object, File As Object, Path As String, TabName As String, i As Long
Set Dict = CreateObject("Scripting.Dictionary"): Path = "E:\Steven\Desktop\Test\"
With CreateObject("Scripting.FileSystemObject")
    For Each File In .GetFolder(Path).Files
        TabName = .GetBaseName(File)
        With Workbooks.Open(File)
            With .ActiveSheet.Range("A3:D" & .ActiveSheet.Cells(.ActiveSheet.Rows.Count, 4).End(xlUp).Row)
                Temp = Application.Index(.Value, Application.Evaluate("Row(1:" & .Rows.Count & ")"), Array(4, 3, 2, 1))
            End With
            .Close False
        End With
        With Sheets.Add
            .Name = Split(TabName, ".")(0)
            With .Range("A1").Resize(UBound(Temp, 1), 4)
                .Value = Temp
                FormatMe .CurrentRegion
            End With
        End With
        For i = 2 To UBound(Temp)
            If Not Dict.exists(Temp(i, 2)) Then
                Dict.Add Temp(i, 2), Temp(i, 3) & ";" & IIf(Temp(i, 4) = "", 0, Temp(i, 4))
            Else
                Dict(Temp(i, 2)) = Split(Dict(Temp(i, 2)), ";")(0) + Temp(i, 3) & ";" & Split(Dict(Temp(i, 2)), ";")(1) + Temp(i, 4)
            End If
        Next i
    Next File
End With
With Sheets("Year")
    .Activate
    .UsedRange.Delete
    .Range("A1").Resize(, 4) = Array("SN", "ITEM", "SALES", "RETURNS")
    .Range("B2").Resize(Dict.Count, 2) = Application.Transpose(Array(Dict.keys, Dict.items))
    .Range("C2").Resize(Dict.Count).TextToColumns .Range("C2"), xlDelimited, semicolon:=True
    With .Range("A2").Resize(Dict.Count): .Value = Evaluate("=Row(" & .Address & ")-1"): End With
    With .Range("A1:D1").Resize(Dict.Count + 1): FormatMe .CurrentRegion: End With
End With
End Sub

[Marc L]

Hi Steve !

If you are stating about my VBA procedure the issue just comes from his new attachment where YEAR worksheet is blank
but according to his original attachment row #1 & 2 must be filled, the first for the headers reorder and the second for the cells formatting …

[Sintek]

@ Marc L

Now I get it...You made use of OP existing Collections sheet supplied in Post 1

[Marc L]

Yes that's it in order to avoid a gas factory procedure 'cause of the reorder and the cells formatting
so easy with the Excel basics advanced filter feature like any Excel beginner operating manually …

[abdo meghari]

Your bad as this is obviously not the same attachment ‼
In particular the collection workbook so try with your initial post attachment
with the Worksheet____4 (YEAR) worksheet as it is (at least rows #1 & 2) …

because it gives object error in with the Worksheet____4 in the beginning when run your code . I expect different office setting , that's why I change name of the sheet

[abdo meghari]

Check out V(L, 2) value...Is Item...hence error...
Perhaps...

thanks but still error shows

[abdo meghari]

@sintek thanks I will test your code and inform you how your code works

[Marc L]

because it gives object error in with the Worksheet____4

Your bad 'cause you did not use the same initial post attachment so just try with it,
you can remove month sheets but not necessary just well reading the code …

[abdo meghari]

Your bad 'cause you did not use the same initial post attachment so just try with it,

I did it ,shows object required error in with the Worksheet____4

[Marc L]

I did it ,shows object required error in with the Worksheet____4

So obviously this is not the initial post attachment !
Just download it from your initial post and run the VBA demonstration twice …

[Marc L]

How do you explain it well works on my side with your initial post attachment ?!

[abdo meghari]

@sintek the code is awesome , but I need avoiding error , if I run again it will pops up This name is already in use, try another name
so if there is way to ignore This name is already in use and add just new name , because every month I want add new report in the same folder has already files which have ever added

[abdo meghari]

@Marc L I don't want to waste your time ,but I use your instructions and implement your code in attached files in OP
here is the file , just test it and inform me if work for you, please?

[Sintek]

@sintek the code is awesome , but I need avoiding error , if I run again it will pops up This name is already in use,

Amended in File...

PS...Marc L code in Post 24 works fine for me...

[abdo meghari]

@sintek thanks again , but when add new sheet it doesn't include summing and merging duplicates items in sheet YEAR .

PS...Marc L code in Post 24 works fine for me...

I will check it again

[Sintek]

but when add new sheet it doesn't include summing and merging duplicates items in sheet YEAR

What you mean new sheet...Surely You mean new file in folder ...
Then I have no idea what you want...because when I add another file or 2...it updates as it should...
The code clears all existing data and overwrites each time button is pressed...
Perhaps you should explain in Step by step detail...

[abdo meghari]

@Marc L I no know what happens for me after many tries now it works , I have no idea why the code doesn't work from the beginning and now works
@ sintek I no know what my bad to cause for all of this chaos .
@Richard Buttrey thanks for your advices
sorry guys ! your codes works now , I hope to not be problems in the future .
much appreciated for your time , patient & assistance

[Sintek]

Glad you got it sorted...Tx for rep +