Macro to compile data from multiple excel files into one summary file

[Kiwirunner]

Hi,

I have one hundred excel files that have the same identical format but have different guest names, guest addresses and arrival dates. What I am trying to do is write a macro that goes into each file, looks to see how many guest names are in each file and then copies this information along with the guests address information into a summary excel sheet.

The 100 identical excel files look as follows (each file will be saved as the group name i.e. "Group 12"):

A B C D E
1 Group 12
2
3 Guest Name Address Arrival Date
4 Joe Bloggs Australia 21/1/12
5 James Henry UK 22/1/12
6 Sarah Henry UK 22/1/12

I am trying to get the summary file to look as follows:

A B C D E
1 Summary File
2
3 Group Guest Name Address Arrival Date
4 12 Joe Bloggs Australia 21/1/12
5 12 James Henry UK 22/1/12
6 12 Sarah Henry UK 22/1/12
7 13 Andrew Walker UK 28/2/12
8 13 Kate Henly USA 29/2/12
9 14 Andy Eaden A 29/2/12

Any help in pointing me in the right direction here would be most appreciated.

Thanks and have a happy NYE!

 

[Kazdima]

Unfortunately, I cannot use Pivot here, because I have specific reporting requirements which Pivot does not give. There should be other Macros that should do what I need... Hopefully other people could help me.

 

[656jamie656]

Hi My Question is a bit complicated but I hope somebody could help


I have a forecasting spreadsheet containing input from 25 people. Each month I take a master spreadsheet and divide it up into separate files for each person based on the name of the sales person in column A in the "input" tab


The VBA macro I am looking for will copy all rows which contain an individual sales person in the "input" tab, paste them into a template I have created on my C drive, name the file according to the sales person name and loop through repeating the process for each sales person then close the master spreadsheet
I would like for the data not to remove the cell formatting when it is pasted into my template

jbeaucaire - you are a brilliant at this, I have used other macros of yours. Any chance you could help me out with this - I'm a VBA novice.

Thanks
656jamie656

 

[jbeaucaire]

I have a macro for taking the data from a database sheet and filling out a template sheet over and over again with the data.

Data Into Template​

The macro fills out the template and saves each one as a separate file OR creates a separate sheet, your choice. That last part can be tweaked to do other things, this is mainly to demonstrate a simple way to fill out a form from a row-based database.


------------------------

Here's a macro for taking a sheet with data and creating individual wbs from each unique value in a chosen column. The date is added to the workbook names to give a reference as to when the wbs were created.

SHEET to WORKBOOKS(1)​

-----------------
Perhaps you can take the concepts outlined in those two macros and merge them into one?

 

[656jamie656]

Thanks so much jbeaucaire - the macro works well. I've taken the concepts you have outlined but I'm still having trouble with a couple of things: 1) I need the data to be pushed into a template in a specific folder location; the data would be pasted on the "input" tab in the template which also has a separate "assumptions" tab. 2) When the data is pasted, on your macro it automatically shrinks the column width - is there a way to keep the format the same as in the template? If you could help me to achieve this that would be greatly appreciated - Sorry to be a nuisance - I am not very good with VBA. Thanks 656jamie656

 

[jbeaucaire]

1) Perhaps this line of code:

Set tSht = Sheets("Template")

...needs to be lengthened to include opening this external workbook?

Dim wbTemplate
Set wbTemplate = Workbooks.Open("C:\Jamie\MyTemplate.xls")
Set tSht = wbTemplate.Sheets("Input")

2) You'll find this line of code in there somewhere meant to "clean up the appearance" of data, you'll want to just take this out:

        Cells.Columns.AutoFit

 

[656jamie656]

Hi Jerry - I am getting a debug error - please can you help. I have also added dimtsht. It seems so close but there are a few teething errors. Thanks so much in advance for your help

The code I have is below: The debug is LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
Option Explicit

Sub ParseItems()
'Jerry Beaucaire (4/22/2010)
'Based on selected column, data is filtered to individual workbooks
'workbooks are named for the value plus today's date
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String
Dim wbTemplate
Dim tsht
Set wbTemplate = Workbooks.Open("C:\Users\Jamie\Desktop\Individual Input Sheet\template.xlsx")
Set tsht = wbTemplate.Sheets("Input")

'Path to save files into, remember the final \
SvPath = "C:\Users\Jamie\Desktop\Individual Input Sheet\template.xlsx\"

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
vTitles = "A8:Z8"

'Choose column to evaluate from, column A = 1, B = 2, etc.
vCol = Application.InputBox("What column to split data by? " & vbLf _
& vbLf & "(A=1, B=2, C=3, etc)", "Which column?", 1, Type:=1)
If vCol = 0 Then Exit Sub

'Spot bottom row of data
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Speed up macro execution
Application.ScreenUpdating = False

'Get a temporary list of unique values from column A
ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
For Itm = 1 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)

ws.Range("A9:A" & LR).EntireRow.Copy
Workbooks.Add
Range("A9").PasteSpecial xlPasteAll
MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1

ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & Format(Date, " MM-DD-YY"), xlNormal
ActiveWorkbook.Close False

ws.Range(vTitles).AutoFilter Field:=vCol
Next Itm

'Cleanup
ws.AutoFilterMode = False
MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True
End Sub
Option Explicit

Sub ParseItems()
'Jerry Beaucaire (4/22/2010)
'Based on selected column, data is filtered to individual workbooks
'workbooks are named for the value plus today's date
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String
Dim wbTemplate
Dim tsht
Set wbTemplate = Workbooks.Open("C:\Users\Jamie\Desktop\Individual Input Sheet\template.xlsx")
Set tsht = wbTemplate.Sheets("Input")

'Path to save files into, remember the final \
SvPath = "C:\Users\Jamie\Desktop\Individual Input Sheet\template.xlsx\"

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
vTitles = "A8:Z8"

'Choose column to evaluate from, column A = 1, B = 2, etc.
vCol = Application.InputBox("What column to split data by? " & vbLf _
& vbLf & "(A=1, B=2, C=3, etc)", "Which column?", 1, Type:=1)
If vCol = 0 Then Exit Sub

'Spot bottom row of data
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Speed up macro execution
Application.ScreenUpdating = False

'Get a temporary list of unique values from column A
ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
For Itm = 1 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)

ws.Range("A9:A" & LR).EntireRow.Copy
Workbooks.Add
Range("A9").PasteSpecial xlPasteAll
MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1

ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & Format(Date, " MM-DD-YY"), xlNormal
ActiveWorkbook.Close False

ws.Range(vTitles).AutoFilter Field:=vCol
Next Itm

'Cleanup
ws.AutoFilterMode = False
MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True
End Sub

 

[jbeaucaire]

Back in the original thread was this section which you've omitted:

'Sheet with data in it, presumes this macro is in that workbook, too.
   Set ws = ThisWorkbook.Sheets("Original Data")

Also, this variable is a PATH to a folder, not a filename, you need to take out the filename at the end:

        SvPath = "C:\Users\Jamie\Desktop\Individual Input Sheet\template.xlsx\"

 

[656jamie656]

Hey Jerry, Thanks it works well.... but for 1 small thing. I can't quite work it out - it doesn't append the data under the template - it just appends it to a new file for each. Could you offer advice as to how I can append it to the "Input" tab on the template sheet for each persons name in Column A, rather than just creating separate files for each person. Again, I'm sorry for the continued asking but I really appreciate your great knowledge

 

[jbeaucaire]

I gave you two macros to work from. The DataIntoTemplate showed you how open a template file and copy data into it. The ParseItems macro was to demonstrate making new workbooks out of the raw data. At the part of the macro where it copies and creates a blank workbook:

 ws.Range("A9:A" & LR).EntireRow.Copy
 Workbooks.Add
 Range("A9").PasteSpecial xlPasteAll

...you need to replace that with techniques you see in the DataToTemplate macro.... copy data, open the template instead of a blank workbook, paste and save.

 

[joseulloa22]

Dear Jerry,
First, I would like to thank you for these great postings.
I have been looking at the solutions you have provided and tried to adjust them to my specific scenario with no luck. I must be doing something wrong and would appreciate if you could provide your guidance. I have more than 100 workbooks contained in some file folders . I would like to extract the data in specific cells from those workbooks and copy them into a summary workbook.
The path name is C:\Jose\AMO\Coater 1 & 2 and the files are named as L11,L12,L13,L41,etc. Inside these file is where my workbooks are located . In example, in file L11, I have workbook "L11F3R GEN M.3 13.00" from which would like to pull the data in worksheet named "QC spec" and cells A1 (Item description),D1 (Item No.),B14 (Specs T) and B15 (Specs R) . (The same cells and worksheets in all the workbooks).
These information would be copied into a Summary workbook and worksheet1. It would look like this

A B C D
1 Item No.(Source: cell D1) Item Description (source: cell A1) Specifications T (source cell B14) Specifications R (source cell B15)
2
3
4
5
etc,

Again, your guidance is tremendously appreciated.
Jose