Solved: Merge Workbooks ...

[kronik]

K.. you guys have been the closest to doing what I've been trying to figure out for a day now..

My question is this; can you make it so that if you have multiple workbooks, with the same sheet names, that you can have one master workbook with 5 worksheets that have the composites of each of the sheets from each of the workbooks? .. for example..

Workbook 1 : Inventory1.xls
- Worksheets in Workbook 1 : Desktops | Laptops | Monitors | Hubs | Printers

Workbook 2 : Inventory2.xls
- Worksheets in Workbook 2 : Desktops | Laptops | Monitors | Hubs | Printers

So instead of having multiple instances of each sheet in the master.. I want 5 ..

Any ideas? Thanks in advance.

[XLGibbs]

Yes this can be done kronik:

[VBA]

Sub LoopThroughFolderFivetoOne()
'dimension variables
Dim wb As Workbook, wbDest1 As Workbook
Dim wsDest1 As Worksheet
Dim i As Long, Pos As Long
Dim folder As String, file As String, Path As String
'folder to loop through
folder = BrowseForFolder
'set destination info
Set wbDest = Workbooks("Master.xls") 'is this correct?
'start filesearch
With Application.FileSearch
.LookIn = folder
.FileName = "Inventory*.xls"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
.Execute
If .Execute > 0 Then
'loop through all found files with Inventory int he file name
For i = 1 To .FoundFiles.Count
'set incidental variables
Pos = InStrRev(.FoundFiles(i), "\")
file = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Pos)
Path = Left(.FoundFiles(i), Pos)
'check if workbook is open. if so, set variable to it, else open it
If IsWbOpen(file) Then
Set wb = Workbooks(file)
Else
Set wb = Workbooks.Open(Path & file)
End If
'set worksheets to copy data from

Dim ws As Worksheet
'go through each sheet, find the same name in master...and copy from source, into destination
For Each ws In wb
Set wsDest1 = wbDest1(ws.Name)
If Not wsDest1 Is Nothing Then
destRow = wsDest1.Cells(wsDest1.Rows.Count, 1).End(xlUp).row.Offset(1)
'specify the source range on each sheet (best if they are consistent)
'copy data from this sheet
ws.Range("A1:A200").Copy 'change range to suit
'paste it into your master sheet
wsDest1.Cells(destRow, 1).PasteSpecial (xlValues) 'paste the data into the next row available

Application.CutCopyMode = False

Next ws


Next i
End If
End With
Set wbDest1 = Nothing
Set wsDest1 = Nothing
End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'''Code from kpuls, www.VBAExpress.com..portion of Knowledge base submission

Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing

Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select

Exit Function

End Function

Function IsWbOpen(wbName As String) As Boolean
On Error Resume Next
IsWbOpen = Len(Workbooks(wbName).Name)
End Function
[/vba]

The code will allow you to browse to a folder, then it will loop through the folder finding each file with Inventory and .xls in the file name. It will then go through the worksheets and find the sheet on Master of the same name and paste the data from that Inventory.xls sheet from the range specificied (you will need to change the range) into the next available row of column A on the Master sheet with the same name...

Untested, but the process has been applied many times over with much success...

can be modified fairly easily....

[kronik]

Throws a next without for error.

[XLGibbs]

Put an End If above the Next Ws line.in first main code where it loops through the sheets...


That error is a paradox. It is not "seeing" the end IF to close the "If not ...is nothing then "check so without the End If , it never gets to the "Next Ws".

Sorry about that, I modified an older much different version to suit your request and added the For each ws loop....

[XLGibbs]

Kronik,

since this is a new topic I split the topic out from the Solved one so you would get the benefit of more readers....


PS Welcome to VBAX!

[XLGibbs]

Sorry, taking a look, I boffoed the code a bit in this piece, below is corrected bold parts are where the changes are specifically

[VBA]

For Each ws In wb
Set wsDest1 = wbDest1.Sheets(ws.Name)
If Not wsDest1 Is Nothing Then
destRow = wsDest1.Cells(wsDest1.Rows.Count, 1).End(xlUp).row.Offset(1)
'specify the source range on each sheet (best if they are consistent)
'copy data from this sheet
ws.Range("A1:A200").Copy 'change range to suit
'paste it into your master sheet
wsDest1.Cells(destRow, 1).PasteSpecial (xlValues) 'paste the data into the next row available

Application.CutCopyMode = False
End IF
Next ws



Hope that helps you out...sorry about the hasty mistakes...

[kronik]

[VBA] Sub LoopThroughFolderFivetoOne()
'dimension variables
Dim wb As Workbook, wbDest1 As Workbook
Dim wsDest1 As Worksheet
Dim i As Long, Pos As Long
Dim folder As String, file As String, Path As String
'folder to loop through
folder = BrowseForFolder
'set destination info
Set wbDest = Workbooks("RS Inventory.xls") 'is this correct?
'start filesearch
With Application.FileSearch
.LookIn = folder
.FileName = "Inventory*.xls"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
.Execute
If .Execute > 0 Then
'loop through all found files with Inventory int he file name
For i = 1 To .FoundFiles.Count
'set incidental variables
Pos = InStrRev(.FoundFiles(i), "\")
file = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Pos)
Path = Left(.FoundFiles(i), Pos)
'check if workbook is open. if so, set variable to it, else open it
If IsWbOpen(file) Then
Set wb = Workbooks(file)
Else
Set wb = Workbooks.Open(Path & file)
End If
'set worksheets to copy data from

Dim ws As Worksheet
'go through each sheet, find the same name in master...and copy from source, into destination
For Each ws In wb
Set wsDest1 = wbDest1.Sheets(ws.Name)
If Not wsDest1 Is Nothing Then
destRow = wsDest1.Cells(wsDest1.Rows.Count, 1).End(xlUp).Row.Offset(1)
'specify the source range on each sheet (best if they are consistent)
'copy data from this sheet
ws.Range("A1:A200").Copy 'change range to suit
'paste it into your master sheet
wsDest1.Cells(destRow, 1).PasteSpecial (xlValues) 'paste the data into the next row available

Application.CutCopyMode = False
End If
Next ws


Next i
End If
End With
Set wbDest1 = Nothing
Set wsDest1 = Nothing
End Sub




Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level

Dim ShellApp As Object

'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, "X:\1715")

'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

'Destroy the Shell Application
Set ShellApp = Nothing

'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select

Exit Function

Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False

End Function


Function IsWbOpen(wbName As String) As Boolean
On Error Resume Next
IsWbOpen = Len(Workbooks(wbName).Name)
End Function

[/VBA]

Hey Gibbs.. your help has been most appreciated.. Still can't get it to work.. tried to run the code you provided; the BrowseForFolder function seemed inoperational so I found another one and plugged that in.. now I'm receiving an error in the Loop function at "For Each ws In wb" stating "Object does not support this property or method. I'm not versed in VBA at all, to my own admission.. is this stating that the "For Each" operation will not work with your worksheet object? I'm almost there..

[XLGibbs]

Well, correct it with

For each ws in Worksheets

that would work. It is better to ask how to fix the error, than admittedly change stuff without knowing what impact it may have...

the browse for folder should have worked to pass the folder name to the loop so not sure what went wrong there....use it all the time now.

That was untested and modified for your purpose, so i don't mind helping you get it to work as you need to....there many ways to skin this kitty.

The key to this is the ranges being copied and pasted in to the master sheet....and if I was right in my assumptions that you want the data to be appended continuously down the sheet in the next available row where the source sheet name = the destination sheet name.

Either way...I can help you get this cooked.

[kronik]

Well, correct it with

For each ws in Worksheets

that would work. It is better to ask how to fix the error, than admittedly change stuff without knowing what impact it may have...

the browse for folder should have worked to pass the folder name to the loop so not sure what went wrong there....use it all the time now.

That was untested and modified for your purpose, so i don't mind helping you get it to work as you need to....there many ways to skin this kitty.

The key to this is the ranges being copied and pasted in to the master sheet....and if I was right in my assumptions that you want the data to be appended continuously down the sheet in the next available row where the source sheet name = the destination sheet name.

Either way...I can help you get this cooked.

Alright.

Received an error on "Set wsDest1 = wbDest1.Sheets(ws.Name)." It would appear this variable has not been declared. I was going to change it to wbDest by itself, without the 1.. as that had been declared but I'm not sure what all that would do.. again, I'm not feigning knowledge here, just trying to use my basic understanding of object-oriented programming to not have to harass you every 10 minutes.

When I did change that, just to see what would happen.. (I can't help it), I received an error @ destRow = wsDest1.Cells(wsDest1.Rows.Count, 1).End(xlUp).Row.Offset(1).

Again, I don't see a destRow declaration.. not even sure what the "row" object is.. again, I'm a noob that was saddled with a task. :P Any guidance here?

I want to stress that I appreciate your assistance by the way; anything I do with tweaking is just fiddling in an attempt to be self-sufficient, not to slight your knowledge in any way, which far surpasses mine.

[XLGibbs]

Maybe you misread me, my point was that you should not worry about asking, but by all means, take stabs at making changes so you might learn in the process.

[vba]
Option Explicit
Sub LoopThroughFolderFivetoOne()
'dimension variables
Dim wb As Workbook, wbDest1 As Workbook, destrow As Long
Dim wsDest1 As Worksheet
Dim i As Long, Pos As Long
Dim folder As String, file As String, Path As String
'folder to loop through
folder = BrowseForFolder
'set destination info
Set wbDest1 = Workbooks("RS Inventory.xls") 'is this correct?
'start filesearch
With Application.FileSearch
.LookIn = folder
.Filename = "Inventory*.xls"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
.Execute
If .Execute > 0 Then
'loop through all found files with Inventory int he file name
For i = 1 To .FoundFiles.Count
'set incidental variables
Pos = InStrRev(.FoundFiles(i), "\")
file = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Pos)
Path = Left(.FoundFiles(i), Pos)
'check if workbook is open. if so, set variable to it, else open it
If IsWbOpen(file) Then
Set wb = Workbooks(file)
Else
Set wb = Workbooks.Open(Path & file)
End If
'set worksheets to copy data from

Dim ws As Worksheet
'go through each sheet, find the same name in master...and copy from source, into destination
For Each ws In Worksheets
Set wsDest1 = wbDest1.Sheets(ws.Name)
If Not wsDest1 Is Nothing Then
destrow = wsDest1.Cells(wsDest1.Rows.Count, 1).End(xlUp).Row.Offset(1)
'specify the source range on each sheet (best if they are consistent)
'copy data from this sheet
ws.Range("A1:A200").Copy 'change range to suit
'paste it into your master sheet
wsDest1.Cells(destrow, 1).PasteSpecial (xlValues) 'paste the data into the next row available

Application.CutCopyMode = False
End If
Next ws


Next i
End If
End With
Set wbDest1 = Nothing
Set wsDest1 = Nothing
End Sub




Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level

Dim ShellApp As Object

'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, "X:\1715")

'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

'Destroy the Shell Application
Set ShellApp = Nothing

'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select

Exit Function

Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False

End Function


Function IsWbOpen(wbName As String) As Boolean
On Error Resume Next
IsWbOpen = Len(Workbooks(wbName).Name)
End Function

[/vba]

Replace your code with that..the variables are declared properly and the syntax appears correct. i don't have time to set up sample files, but will in the meantime while you try that out... I just edited the code from your reply before....so some of your changes are in there (like the wbDest1 filename...)

No worries on harrassing me!

[XLGibbs]

Kronik.

I just tested this code and it works..one minor change in the above code and it is good to go..

[VBA]
destrow = wsDest1.Cells(wsDest1.Rows.Count, 1).End(xlUp).Offset(1).Row
[/vba]

is the correct syntax for that line (mine had destrow = .......Row.Offset(1) )

also, make sure your source range is correct (right now it is set to A1:A200)

attached is the folder I tested with.. Make sure the tab names have the same names, that is key as well..

To test, just extract the attached files and open the destination.xls file. Run the code "loopthroughfolderfivetoone"

You can run it as many times as you like to see what it does.

But it does do what is intended I believe.

[kronik]

You my friend, freaking rock.

How can I get it to close the workbooks as it goes through them? I end up with 14 open; I'd like to just have the consolidated one open.

THANKS AGAIN.

[XLGibbs]

In the loop right before "Next wb"

put

[vba]

wb.Close False

[/vba]

Which will close the file (The false tells it to not ask to save changes by saying NO upfront...)
And if you could rate the thread and mark it solved using thread tools. Glad to have helped you out with this...let me know if there is anything further I can help out with.

[XLGibbs]

Ooops. I meant before the "Next i" put that Wb.Close False line

[kronik]

K.. problem is that closes all of the windows, including my master that I run the macro from..

Also, how simple is it to make it a constant directory that it will be running the loop through.. and only on files, say named, RS Inventory *.xls?

Also.. just to satisfy my curiosity.. is there a way to accomplish this without a macro? i.e. data sourcing ?

[XLGibbs]

Okay, it shouldn't be closing all the windows ....
is it here?
[VBA]
For Each ws In Worksheets
Set wsDest1 = wbDest1.Sheets(ws.Name)
If Not wsDest1 Is Nothing Then
destrow = wsDest1.Cells(wsDest1.Rows.Count, 1).End(xlUp).Offset(1).Row
'specify the source range on each sheet (best if they are consistent)
'copy data from this sheet
ws.Range("A1200").Copy 'change range to suit
'paste it into your master sheet
wsDest1.Cells(destrow, 1).PasteSpecial (xlValues) 'paste the data into the next row available

Application.CutCopyMode = False
End If
Next ws

wb.Close '<========this is where it should go.Tested.does not close all windows

Next i

[/VBA]

As far as the harcoded path...

Just replace
[VBA]
folder = browsetofolder
[/vba]

with
[vba]
folder = "C:\Folder\Folder"

[/vba]

where you just put the full path...

this section can be modified to specify the part of the file name to find...

[VBA]
With Application.FileSearch
.LookIn = folder
.Filename = "Source*.xls" '<=====change this to "RS Inventory*.xls" if you like
[/vba]

Does that help?


PS. I DO Rock.....see --->>>>>

[kronik]

[VBA] Dim ws As Worksheet
'go through each sheet, find the same name in master...and copy from source, into destination
For Each ws In Worksheets
Set wsDest1 = wbDest1.Sheets(ws.Name)
If Not wsDest1 Is Nothing Then
destrow = wsDest1.Cells(wsDest1.Rows.Count, 1).End(xlUp).Offset(1).Row
'specify the source range on each sheet (best if they are consistent)
'copy data from this sheet
ws.Range("A2:K2000").Copy 'change range to suit
'paste it into your master sheet
wsDest1.Cells(destrow, 1).PasteSpecial (xlValues) 'paste the data into the next row available

Application.CutCopyMode = False
End If
Next ws


wb.Close
Next i
End If
End With
Set wbDest1 = Nothing
Set wsDest1 = Nothing
End Sub[/VBA]

Still closes all windows.. perhaps I'm running the macro incorrectly..?

You didn't comment on the data source question; I'm curious because this would be ideal to the macro but the macro is functional and will serve its' purpose though I'm sure the boss-types would prefer a less invasive process. ;P

Another functional request... clearing out the workbook entries on everything but row 1 every time the macro is run.

[XLGibbs]

Ummm....I can't explain why it closes all windows since the wb variable is only referring to the one workbook being copied. Are you running it from the master file? Is the code currently contained in the master file?

The sample I sent you...if you open destiantion.xls and run the macro, you browse to the folder with the Source.xls file and hit okay, it copies the data and closes the source.xls file leaving the destination file open...


Can't be done without a macro in excel, but there are ways to set the file to auto open and execute the macro on open. You could have a Visual Basic program developed to duplicate the tasks since the code is not all that different...but the application would still have to be kicked off somehow...it would depend on the resources available...SQL Servers have DTS packages that can contain the VB Script (even though the data is not on the server, but the server would have to have the necessary directory access)

You can make it a little smoother by adding:

[VBA]
Application.EnableEvents = False
Application.ScreenUpdating = False
[/vba]

at the beginning of the code

and then repeating at the end but setting them to TRUE

[kronik]

Added that ApplicationEvents entry and it works fine, doesn't close it.

So, problem remedied except cleaning the workbook before each population. I would assume something like copy sheet1.a2:k10000 with a null value would work?

[XLGibbs]

Just run this before you run the copy macro change the workbook name as needed..

[VBA]

With Workbooks("Destination.xls")
For each Ws in Worksheets
Ws.Cells.ClearContents
Next ws
End with
[/VBA]

Or if you only want certain sheets cleared

[VBA]
With Workbooks("Destination.xls")
Sheets(Array("Sheet5", "Sheet4", "Sheet3", "Sheet2", "Sheet1")).Select
Selection.Cells.ClearContents

Sheets("Sheet1").Select

End With
[/VBA]

Just change the workbook name and sheet names as appropriate..