Summary from unopened workbooks

  • Thread starter BNT1 via OfficeKB.com
  • Start date
B

BNT1 via OfficeKB.com

Hi

I have 20 workbooks, all the same, with one summary sheet in each named
"Summary" . The "summary" sheet is the first sheet in each workbook
What i require is one new workbook, that adds all those summaries together
File for all those workbooks is J / Distribution KPI / "then the appropriate
workbook name"
Range in the "summary" sheet is A1:N44, (this range does include header row
and there are a few blank rows used to break-up the data (formating)
I have limited macro knowledge, but i can copy/paste or tweek if not too
complicated
Hope this makes sense

Any suggestions

Excel 2002
Regards

Brian
 
R

Ron de Bruin

See the link that Gord posted or start here
http://www.rondebruin.nl/copy3.htm


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


BNT1 via OfficeKB.com said:
thanks Ron for the quick response

I have tried to understand some of these links on other threads.
Not sure if permitted to dowload utility at work, will give it a go in the
morning and revert. If I cannot, can you point me to any VBA that is
available

regards

Try this add-in
http://www.rondebruin.nl/merge.htm
[quoted text clipped - 15 lines]
 
S

ShaneDevenshire

Hi,

To make life easier you should name each of the ranges in the individual
files which you want to combine, but its not necessary.

You could program the following steps, but its not necessary:

1. Note the range from you want to consolidate from and the sheet name each
of the files (this is easy if the sheet names are the same and simple and if
the ranges are all the same, if not range names would be very useful.)
2. Move to the new file, the summary file where you want the summary
3. Choose the command Data, Consolidate,
4. Click in the References box and click Browse and navigate to the folder
where the file(s) are, select the file and click OK
5. Enter the sheet name and cell address after the file name (if you use
range names you won't need a sheet name or cell address only the range name).
6. click Add.
7. Click Browse and repeat steps 4-6 for each file (you only need to do this
once!)
8. After adding all 20 files click OK.

You should practice this with just two files until you have got it down
because its easy to make small errors. Try to use sheet names without spaces
or range names

The next time you want to rerun the consolidate command on this sheet you
will not need to enter all the info again.


Once you've done it manually, you can turn on the recorder and just run the
Data, Consolidate commad and see the code Excel creates. Something like
this:

Selection.Consolidate Sources:=Array( _
"'C:\Users\Shane\Documents\Invoice Sept 08.xls'!data", _
"'C:\Users\Shane\Documents\September Invoice 2008.xls'!data"),
Function:= _
xlSum, TopRow:=False, LeftColumn:=False, CreateLinks:=False


If you are into VBA, with a little practice you can figure out how to modify
this code to make it dynamic or whatever you want.
 
B

BNT1 via OfficeKB.com

Hi ron

I am not very up on VBA especially at this level, however, i'm still
interested !. I have this code from the link you sent.

Firstly, is it the right code that I have copied to get all the "summary"
sheets added together in a folder ?
Where abouts in the code do I insert my file name J:\distribution KPI
(distribution KPI is the folder name)
Where abouts in the code would i insert the filenames? ( example, Luton,
Purfleet,Washington etc)
and i think lastly, the sheets named "summary" in each workbook are those
that are to be summed together, where in the code is that instruction and its
cell perameters?

regards

Brian


Private myFiles() As String
Private Fnum As Long

Function Get_File_Names(MyPath As String, Subfolders As Boolean, _
ExtStr As String, myReturnedFiles As Variant) As Long

Dim Fso_Obj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object

If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'Create FileSystemObject object
Set Fso_Obj = CreateObject("Scripting.FileSystemObject")

Erase myFiles()
Fnum = 0

'Test if the folder exist and set RootFolder
If Fso_Obj.FolderExists(MyPath) = False Then
Exit Function
End If
Set RootFolder = Fso_Obj.GetFolder(MyPath)

'Fill the array(myFiles)with the list of Excel files in the folder(s)
'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(file.Name) Like LCase(ExtStr) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = MyPath & file.Name
End If
Next file

'Loop through the files in the Sub Folders if SubFolders = True
If Subfolders Then
Call ListFilesInSubfolders(OfFolder:=RootFolder, FileExt:=ExtStr)
End If

myReturnedFiles = myFiles
Get_File_Names = Fnum
End Function


Sub ListFilesInSubfolders(OfFolder As Object, FileExt As String)
'Origenal SubFolder code from Chip Pearson
'http://www.cpearson.com/Excel/RecursionAndFSO.htm
'Changed by Ron de Bruin, 27-March-2008
Dim SubFolder As Object
Dim fileInSubfolder As Object

For Each SubFolder In OfFolder.Subfolders
ListFilesInSubfolders OfFolder:=SubFolder, FileExt:=FileExt

For Each fileInSubfolder In SubFolder.Files
If LCase(fileInSubfolder.Name) Like LCase(FileExt) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = SubFolder & "\" & fileInSubfolder.Name
End If
Next fileInSubfolder

Next SubFolder
End Sub

See the link that Gord posted or start here
http://www.rondebruin.nl/copy3.htm
thanks Ron for the quick response
[quoted text clipped - 13 lines]
 
R

Ron de Bruin

Hi

We start with this basic example for all files in this folder
MyPath = "J:\distribution KPI"

It will copy this range
Set sourceRange = .Range("A1:N44")


Open a new workbook
Alt F11
Insert Module

Copy the code below in the module
Then use Alt q to close the VBA editor
Use Alt F8 to select and run the macro

Post back with good or bad news<g>

Sub Basic_Example_1()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long

'Fill in the path\folder where the files are
MyPath = "J:\distribution KPI"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then

On Error Resume Next

With mybook.Worksheets(1)
Set sourceRange = .Range("A1:N44")
End With

If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
'if SourceRange use all columns then skip this file
If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0

If Not sourceRange Is Nothing Then

SourceRcount = sourceRange.Rows.Count

If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "Sorry there are not enough rows in the sheet"
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else

'Copy the file name in column A
With sourceRange
BaseWks.Cells(rnum, "A"). _
Resize(.Rows.Count).Value = MyFiles(Fnum)
End With

'Set the destrange
Set destrange = BaseWks.Range("B" & rnum)

'we copy the values from the sourceRange to the destrange
With sourceRange
Set destrange = destrange. _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value

rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If

Next Fnum
BaseWks.Columns.AutoFit
End If

ExitTheSub:
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


BNT1 via OfficeKB.com said:
Hi ron

I am not very up on VBA especially at this level, however, i'm still
interested !. I have this code from the link you sent.

Firstly, is it the right code that I have copied to get all the "summary"
sheets added together in a folder ?
Where abouts in the code do I insert my file name J:\distribution KPI
(distribution KPI is the folder name)
Where abouts in the code would i insert the filenames? ( example, Luton,
Purfleet,Washington etc)
and i think lastly, the sheets named "summary" in each workbook are those
that are to be summed together, where in the code is that instruction and its
cell perameters?

regards

Brian


Private myFiles() As String
Private Fnum As Long

Function Get_File_Names(MyPath As String, Subfolders As Boolean, _
ExtStr As String, myReturnedFiles As Variant) As Long

Dim Fso_Obj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object

If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'Create FileSystemObject object
Set Fso_Obj = CreateObject("Scripting.FileSystemObject")

Erase myFiles()
Fnum = 0

'Test if the folder exist and set RootFolder
If Fso_Obj.FolderExists(MyPath) = False Then
Exit Function
End If
Set RootFolder = Fso_Obj.GetFolder(MyPath)

'Fill the array(myFiles)with the list of Excel files in the folder(s)
'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(file.Name) Like LCase(ExtStr) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = MyPath & file.Name
End If
Next file

'Loop through the files in the Sub Folders if SubFolders = True
If Subfolders Then
Call ListFilesInSubfolders(OfFolder:=RootFolder, FileExt:=ExtStr)
End If

myReturnedFiles = myFiles
Get_File_Names = Fnum
End Function


Sub ListFilesInSubfolders(OfFolder As Object, FileExt As String)
'Origenal SubFolder code from Chip Pearson
'http://www.cpearson.com/Excel/RecursionAndFSO.htm
'Changed by Ron de Bruin, 27-March-2008
Dim SubFolder As Object
Dim fileInSubfolder As Object

For Each SubFolder In OfFolder.Subfolders
ListFilesInSubfolders OfFolder:=SubFolder, FileExt:=FileExt

For Each fileInSubfolder In SubFolder.Files
If LCase(fileInSubfolder.Name) Like LCase(FileExt) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = SubFolder & "\" & fileInSubfolder.Name
End If
Next fileInSubfolder

Next SubFolder
End Sub

See the link that Gord posted or start here
http://www.rondebruin.nl/copy3.htm
thanks Ron for the quick response
[quoted text clipped - 13 lines]
 
B

BNT1 via OfficeKB.com

Hi Ron

Just tried this and it produced a summary sheet. Regretfully, I have spent a
lot of time with formulas and help from this forum to get my summary sheet in
the conventional way. Now I know a quicker, easier way for next time.!!
When running the macro, I did get the data from both files in my test folder,
however, it produced one summary beneath the other. Should have the
respective values been added togetrher to produce one set of values?

I have used did use Shane's consolidate method to achieve a summary from all
workbooks in the folder

Thank you all for the help, much appriciated

Regards

Brain
Hi ron

I am not very up on VBA especially at this level, however, i'm still
interested !. I have this code from the link you sent.

Firstly, is it the right code that I have copied to get all the "summary"
sheets added together in a folder ?
Where abouts in the code do I insert my file name J:\distribution KPI
(distribution KPI is the folder name)
Where abouts in the code would i insert the filenames? ( example, Luton,
Purfleet,Washington etc)
and i think lastly, the sheets named "summary" in each workbook are those
that are to be summed together, where in the code is that instruction and its
cell perameters?

regards

Brian

Private myFiles() As String
Private Fnum As Long

Function Get_File_Names(MyPath As String, Subfolders As Boolean, _
ExtStr As String, myReturnedFiles As Variant) As Long

Dim Fso_Obj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object

If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'Create FileSystemObject object
Set Fso_Obj = CreateObject("Scripting.FileSystemObject")

Erase myFiles()
Fnum = 0

'Test if the folder exist and set RootFolder
If Fso_Obj.FolderExists(MyPath) = False Then
Exit Function
End If
Set RootFolder = Fso_Obj.GetFolder(MyPath)

'Fill the array(myFiles)with the list of Excel files in the folder(s)
'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(file.Name) Like LCase(ExtStr) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = MyPath & file.Name
End If
Next file

'Loop through the files in the Sub Folders if SubFolders = True
If Subfolders Then
Call ListFilesInSubfolders(OfFolder:=RootFolder, FileExt:=ExtStr)
End If

myReturnedFiles = myFiles
Get_File_Names = Fnum
End Function

Sub ListFilesInSubfolders(OfFolder As Object, FileExt As String)
'Origenal SubFolder code from Chip Pearson
'http://www.cpearson.com/Excel/RecursionAndFSO.htm
'Changed by Ron de Bruin, 27-March-2008
Dim SubFolder As Object
Dim fileInSubfolder As Object

For Each SubFolder In OfFolder.Subfolders
ListFilesInSubfolders OfFolder:=SubFolder, FileExt:=FileExt

For Each fileInSubfolder In SubFolder.Files
If LCase(fileInSubfolder.Name) Like LCase(FileExt) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = SubFolder & "\" & fileInSubfolder.Name
End If
Next fileInSubfolder

Next SubFolder
End Sub
See the link that Gord posted or start here
http://www.rondebruin.nl/copy3.htm
[quoted text clipped - 4 lines]
 
R

Ron de Bruin

Good to hear that you got it working

Have a nice day

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


BNT1 via OfficeKB.com said:
Hi Ron

Just tried this and it produced a summary sheet. Regretfully, I have spent a
lot of time with formulas and help from this forum to get my summary sheet in
the conventional way. Now I know a quicker, easier way for next time.!!
When running the macro, I did get the data from both files in my test folder,
however, it produced one summary beneath the other. Should have the
respective values been added togetrher to produce one set of values?

I have used did use Shane's consolidate method to achieve a summary from all
workbooks in the folder

Thank you all for the help, much appriciated

Regards

Brain
Hi ron

I am not very up on VBA especially at this level, however, i'm still
interested !. I have this code from the link you sent.

Firstly, is it the right code that I have copied to get all the "summary"
sheets added together in a folder ?
Where abouts in the code do I insert my file name J:\distribution KPI
(distribution KPI is the folder name)
Where abouts in the code would i insert the filenames? ( example, Luton,
Purfleet,Washington etc)
and i think lastly, the sheets named "summary" in each workbook are those
that are to be summed together, where in the code is that instruction and its
cell perameters?

regards

Brian

Private myFiles() As String
Private Fnum As Long

Function Get_File_Names(MyPath As String, Subfolders As Boolean, _
ExtStr As String, myReturnedFiles As Variant) As Long

Dim Fso_Obj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object

If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'Create FileSystemObject object
Set Fso_Obj = CreateObject("Scripting.FileSystemObject")

Erase myFiles()
Fnum = 0

'Test if the folder exist and set RootFolder
If Fso_Obj.FolderExists(MyPath) = False Then
Exit Function
End If
Set RootFolder = Fso_Obj.GetFolder(MyPath)

'Fill the array(myFiles)with the list of Excel files in the folder(s)
'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(file.Name) Like LCase(ExtStr) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = MyPath & file.Name
End If
Next file

'Loop through the files in the Sub Folders if SubFolders = True
If Subfolders Then
Call ListFilesInSubfolders(OfFolder:=RootFolder, FileExt:=ExtStr)
End If

myReturnedFiles = myFiles
Get_File_Names = Fnum
End Function

Sub ListFilesInSubfolders(OfFolder As Object, FileExt As String)
'Origenal SubFolder code from Chip Pearson
'http://www.cpearson.com/Excel/RecursionAndFSO.htm
'Changed by Ron de Bruin, 27-March-2008
Dim SubFolder As Object
Dim fileInSubfolder As Object

For Each SubFolder In OfFolder.Subfolders
ListFilesInSubfolders OfFolder:=SubFolder, FileExt:=FileExt

For Each fileInSubfolder In SubFolder.Files
If LCase(fileInSubfolder.Name) Like LCase(FileExt) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = SubFolder & "\" & fileInSubfolder.Name
End If
Next fileInSubfolder

Next SubFolder
End Sub
See the link that Gord posted or start here
http://www.rondebruin.nl/copy3.htm
[quoted text clipped - 4 lines]
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top