PDA

View Full Version : Solved: Merge Workbooks ...



kronik
02-15-2006, 09:17 PM
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
02-15-2006, 09:43 PM
Yes this can be done kronik:



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 (http://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


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
02-15-2006, 10:06 PM
Throws a next without for error. :(

XLGibbs
02-15-2006, 10:31 PM
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
02-15-2006, 10:33 PM
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!http://vbaexpress.com/forum/images/smilies/039.gif

XLGibbs
02-15-2006, 10:37 PM
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...http://vbaexpress.com/forum/images/smilies/banghead.gif

kronik
02-16-2006, 03:28 PM
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 (file:///servernamesharename). 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



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.. :banghead:

XLGibbs
02-16-2006, 04:05 PM
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
02-16-2006, 04:22 PM
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
02-16-2006, 04:29 PM
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.


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



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
02-16-2006, 04:40 PM
Kronik.

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


destrow = wsDest1.Cells(wsDest1.Rows.Count, 1).End(xlUp).Offset(1).Row


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
02-16-2006, 04:58 PM
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. :bow:

XLGibbs
02-16-2006, 05:03 PM
In the loop right before "Next wb"

put



wb.Close False



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.
http://vbaexpress.com/forum/images/smilies/023.gif

XLGibbs
02-16-2006, 05:04 PM
Ooops. I meant before the "Next i" put that Wb.Close False line

kronik
02-16-2006, 05:11 PM
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
02-16-2006, 05:17 PM
Okay, it shouldn't be closing all the windows ....
is it here?

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("A1:D200").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



As far as the harcoded path...

Just replace

folder = browsetofolder


with

folder = "C:\Folder\Folder"



where you just put the full path...

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


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


Does that help?


PS. I DO Rock.....see --->>>>>http://vbaexpress.com/forum/images/smilies/band.gif

kronik
02-16-2006, 05:28 PM
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

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. : pray2:

XLGibbs
02-16-2006, 05:40 PM
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:


Application.EnableEvents = False
Application.ScreenUpdating = False


at the beginning of the code

and then repeating at the end but setting them to TRUE

kronik
02-16-2006, 06:01 PM
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
02-16-2006, 06:14 PM
Just run this before you run the copy macro change the workbook name as needed..



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


Or if you only want certain sheets cleared


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

Sheets("Sheet1").Select

End With


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

kronik
02-16-2006, 06:31 PM
I tried adding that to the code but not sure where it should go..

Can I have a function for it, that just clears it before all of the other operations are run?

What's the proper syntax for declaration in that case.. (meaning what would I add to make this work in that manner.)

With Workbooks("Destination.xls")
For Each Ws In Worksheets
Ws.Cells.ClearContents
Next ws
End With

XLGibbs
02-16-2006, 06:35 PM
Put that at the top of the main procedure where the Set wbDest1 is ...as follows:


'set destination info
Set wbDest1 = Workbooks("Destination.xls") 'is this correct?
Dim ws As Worksheet
With wbDest1
For Each ws In Worksheets
ws.Cells.ClearContents
Next ws
End With


that way it will clear out the data when you fire the main procedure...

kronik
02-16-2006, 06:38 PM
Damn you respond quick.. :P

It seems to consistently clear Cell A1 in the first sheet, .. any idea how to stop that from happening?

XLGibbs
02-16-2006, 06:40 PM
Okay then change it to...
'set destination info
Set wbDest1 = Workbooks("Destination.xls") 'is this correct?
Dim ws As Worksheet
With wbDest1
For Each ws In Worksheets
ws.Range("A2:K" & cells(ws.rows.count,1).End(xlup).Row)
Next ws
End With

That would only clear out row 2 on down. Change the "A2" to whichever row you want to start in...(like "A3" if you have 2 header rows.

kronik
02-16-2006, 06:45 PM
ws.Range ("A2:K" & Cells(ws.Rows.Count, 1).End(xlUp).Row)

throws invalid user of property on Range.



Option Explicit
Sub ConsolidateInv()
Application.EnableEvents = False
Application.ScreenUpdating = False
'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 = "C:\"
'set destination info
Set wbDest1 = Workbooks("Inventory.xls") 'is this correct?
'set destination info
Set wbDest1 = Workbooks("Inventory.xls") 'is this correct?
Dim ws As Worksheet
With wbDest1
For Each ws In Worksheets
ws.Range ("A2:K" & Cells(ws.Rows.Count, 1).End(xlUp).Row)
Next ws
End With
'start filesearch

XLGibbs
02-16-2006, 06:51 PM
Yes it will! Doh!

ws.Range(Cells(2, 1), Cells(ws.Rows.Count, 11).End(xlUp)).ClearContents

change the 2 in the first part to the row where you want it to start the clearing...


also,

further down in the code Dim Ws as Worksheet appears again...remove that 2nd one since it is being added up top with this bit.

kronik
02-16-2006, 06:55 PM
Method Range of object '_Worksheet' failed :bug:

XLGibbs
02-16-2006, 07:08 PM
Sorry, my bad..

ws.Range(ws.Cells(2, 1), ws.Cells(ws.Rows.Count, 11)).End(xlUp).ClearContents

this requires that both column A and column K have the same amount of rows with data...

you can just as easily just do

ws.Range("A2:K20000").clearcontents

instead of that line to keep it uniform....

:)

kronik
02-16-2006, 07:12 PM
lol, I had just done that and was about to respond saying don't worry about it. ;) Thank you again, so much. I think I'm done!:cloud9:

kronik
02-16-2006, 08:33 PM
Hey Gibbs.. last question I think..

Every time I save my workbook on Sharepoint, the macro button keeps wanting to assign it a http value as opposed to just the "ConsolidateInv" in the workbook. Any way to prevent this?

XLGibbs
02-16-2006, 08:41 PM
I am not sure what you mean....I am not at all familar with Sharepoint and it's related issues....I wish I had an answer...I couldn't find what at MSDN, but I am not sure where to start!

kronik
02-16-2006, 09:24 PM
It has something to do with it being loaded and saved to Sharepoint.. so it's getting saved to http://etc.. and then when it looks for the macro, it wants to look in http://etc.. as opposed to just trying to run from the local macro.. it's hard to explain. Basically, I have to go into tools -> macro each time, I can't make a button for it.

XLGibbs
02-16-2006, 09:26 PM
Oohh.....you need to use a different kind of button...use one from the Visual Basic Forms toolbar...(not the one that you can just "Assign Macro" with)

Create the button and select "view code" ...in the buttons Click_Event that shows up when you do that you just need to type your macro name

that may resolve it...

kronik
02-17-2006, 06:52 AM
Yes, it would appear that it has.. cool. Is there any way to move that into the toolbar as opposed to having it embedded on the first sheet?

So, I'm still having trouble with the macro closing my RS Inventory sheet.. growl.. not sure where something is wrong.. Seemed it was fixed locally but not on the shared drive (Sharepoint) where it's located.

I'll paste my whole code in here.. perhaps I have it in the wrong place or something is missing.


Option Explicit
Sub ConsolidateInv()
Application.EnableEvents = False
Application.ScreenUpdating = False
'dimension variables
Dim wb As Workbook, wbDest1 As Workbook, destrow As Long
Dim wsDest1 As Worksheet
Dim ws As Worksheet
Dim i As Long, Pos As Long
Dim folder As String, file As String, Path As String
'folder to loop through
With wbDest1
For Each ws In Worksheets
ws.Range("A2:K20000").ClearContents
Next ws
End With
folder = "\\sharepoint\ (file://\sharepointeso-sitesfrsuppfrsuppphase1SupportDriversHelpdesk)Documents"
'set destination info
Set wbDest1 = Workbooks("RS Inventory.xls") 'is this correct?
'start filesearch
With Application.FileSearch
.LookIn = folder
.FileName = "RS 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).Offset(1).Row
'specify the source range on each sheet (best if they are consistent)
'copy data from this sheet
ws.Range("A2:K20000").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
Application.EnableEvents = True
Application.ScreenUpdating = True
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 (file://\servernamesharename). 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

kronik
02-17-2006, 07:11 AM
I think I got it.. RS Inventory (my destination) was being counted in the sources by the RS Inventory*.xls file search.. changed it to RS Consolidated Inventory.xls and it seems to be working.

kronik
02-17-2006, 08:47 AM
Ok.. so.. BLAH, I hate this job.


So..

I'm trying to incorporate lists into this spreadsheet.. Data -> Lists -> Create List/Publish List.. right.

But I want it to actually change every time the macro is run.. so that the list has the most current data. It adds an ID column in A, moving my headers over one column.

It's probably ideal if I attach a sample.

edit - Remedied this by using named ranges..

Now I have to figure out how to get Sharepoint lists to combine... :doh:

One last question.. is there a reason that running the macro works for me but no one else if it references a shared location for the files and the macro is embedded in the workbook?

Thanks again, Gibbs.

XLGibbs
02-17-2006, 03:01 PM
Not sure on the last part...does sharepoint offer the option of enabling macros?

For a toolbar button instead you can use this, place it in the On_Open event of the file...




Dim cbar As CommandBar, cBarButton As CommandBarButton
On Error Resume Next
Application.CommandBars("Consolidate Inv").Delete

Set cbar = Application.CommandBars.Add("Considate Inv", Position:=msoBarTop, _
Temporary:=True) 'adds the toolbar
With cbar 'perform below on the new cBar

Set cBarButton = cbar.Controls.Add(Type:=msoControlButton)
cBarButton.Caption = "Consolidate Inventory" 'add a drop down label on the toolbar

With cBarButton
.OnAction = "ConsolidateInv" 'macro name here
.FaceId = 142
.Style = msoButtonIconAndCaption
End With
End With

cbar.Visible = True

Set cbar = Nothing
Set cBarButton = Nothing



I set it up so you can add other buttons as well if need be...just let me know...

In the BeforeClose Event you want


Application.CommandBars("Consolidate Inv").Delete


So it goes away when the file does...