Solved: Copy Worksheets Based on "View"

[jo15765]

I am running the below code for about 20 different workbooks that the data is refreshed via DAO daily. And all 20 have the View defined at the top
as either public or private. This is the code I am running for that (well this is one of the procedures (I have 19 others)
[VBA]
Public Sub NumberOne()
Dim wb As Workbook
Dim View
Dim Rng As Range

View = "Private"

Set wb = Workbooks.Open(Filename:="C:\Monday\Dave\workbook1.xls")
'Function that via DAO imports data from query
Call GetAccessDataDAO
'Function that will put the Date column in the format of yyyymmdd
Call Format_Date
'Function that will delete the header rows from the worksheets
Call D_Headers

'Function that if no "new" data was imported will not save the workbook
Set wb = ActiveWorkbook
Set Rng = Range("A3:A4")

If Application.CountA(Rng) = 0 Then
wb.Close
Else
Const sPath As String = "C:\Daily\Checked\"
Dim avsFolder As Variant
Dim i As Long

avsFolder = "Checked"

MkDir sPath & avsFolder
wb.SaveAs Filename:="C:\Daily\Checked\" & wb.Name
End If
End Sub
[/VBA]
I was wondering if once all the workbooks have been refreshed if I could then add an If statement at the end that says
something like
[VBA]
For each View = "Private" Then
Workbooks.Sheets(2).Copy
Next View
[/VBA]

I know the above doesn't work because I have tested it, but something to that effect. Basically for each workbook where the view is "Private"
copy the 2nd worksheet to a new workbook (copy all of them to the same workbook), and then for each workbook where the view is set to "Public"
copy the 2nd worksheet to a new workbook (again copy all of them into the same workbook)

[mdmackillop]

A couple of options
You could write "Private/Public" to a Custom or BuiltInDocumentProperty and check that property.
Create a textfile to hold the names/paths and the Private.Public value

Are all the workbooks updated by the one macro? If so, you could save the data in an array, then run code using that data.

[jo15765]

Each workbook has there own macro (coded just like the above).

Your top two solutions are above my head in the World of VBA....they are probably feasible solutions, I just wouldn't know where to begin in doing those..

[mdmackillop]

[vba]'Add to your Workbook codes
'Set property
ActiveWorkbook.BuiltinDocumentProperties(4) = "Private" '/"Public"


'Code to copy sheets

Sub GetFiles()
Dim Pth As String
Dim Arr, a
Dim WB As Workbook
Dim wbPub As Workbook
Dim wbPri As Workbook



Pth = "C:\Daily\Checked\"
'Workbook names
Arr = Array("Data1", "Data2", "Data3")

'Create new workbooks to hold sheet 2 copies
Set wbPub = Workbooks.Add
wbPub.SaveAs ("C:\Daily\Public.xlsx")
Set wbPri = Workbooks.Add
wbPri.SaveAs ("C:\Daily\Private.xlsx")

'Open each book in turn and check property
For Each a In Arr
Set WB = Workbooks.Open(Pth & a & ".xlsx")
Select Case WB.BuiltinDocumentProperties(4)
Case "Private"
'copy sheet 2
WB.Sheets(2).Copy Before:=wbPri.Sheets(1)
Case "Public"
WB.Sheets(2).Copy Before:=wbPub.Sheets(1)
End Select
WB.Close False
Next

'Save and close workbooks
wbPub.Close True
wbPri.Close True

End Sub
[/vba]

[jo15765]

I get a compile error on this portion of the code:

Compile error:
Invalid Oustide Procedure

And it highlights "Private"
ActiveWorkbook.BuiltinDocumentProperties(4) = "Private" '/"Public"

Also, do I need to place this code in each workbook that I am wanting to run the code in? Or can I place the code in my "Programming"
Workbook, where I have all my code placed, that calls each sub-procedure etc etc

[mdmackillop]

That line will go into your NumberOne code

[jo15765]

So this line of code:
[VBA]
ActiveWorkbook.BuiltinDocumentProperties(4) = "Private" '/"Public"
[/VBA]

Goes into each different module, and I will let it equal Public/Private depending on which type it actually equals?

[jo15765]

The problem that I am running into is that each workbook in the array is in its own folder (this was a change I had to make after my initial post was made on here). So for example my Pth for folder one would be
[vba]
Pth = "C:\Daily\Checked\Workbook1\WB.Name"
[/vba]
And the path for the next workbook would be
[vba]
PTH = "C:\Daily\Checked\Workbook2\WB.Name"
[/vba]
Can you think of an easy way to use this same code, but have it look in "sub folders" as opposed to just the main folder?

[mdmackillop]

[vba]'Code to copy sheets

Sub GetFiles()
Dim Pth As String
Dim Arr, a
Dim WB As Workbook
Dim wbPub As Workbook
Dim wbPri As Workbook
Dim MyDirs()
Dim MyWB As String


MyWB = "Test.xlsx" '<===Adjust as required

ReDim MyDirs(50)
' Display the names in that represent directories.
MyPath = "C:\Daily\Checked\" ' Set the path.
MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
Do While MyName <> "" ' Start the loop.
' Use bitwise comparison to make sure MyName is a directory.
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
' Display entry only if it's a directory.
MyDirs(i) = MyName
i = i + 1
End If
MyName = Dir() ' Get next entry.
Loop
ReDim Preserve MyDirs(i - 1)


'Create new workbooks to hold sheet 2 copies
Set wbPub = Workbooks.Add
wbPub.SaveAs ("C:\Daily\Public.xlsx")
Set wbPri = Workbooks.Add
wbPri.SaveAs ("C:\Daily\Private.xlsx")

For i = 0 To i - 1
'Open each book in turn and check property
Set WB = Workbooks.Open("C:\Daily\Checked\" & MyDirs(i) & "\" & MyWB)
Select Case WB.BuiltinDocumentProperties(4)
Case "Private"
'copy sheet 2
WB.Sheets(2).Copy Before:=wbPri.Sheets(1)
Case "Public"
WB.Sheets(2).Copy Before:=wbPub.Sheets(1)
End Select
WB.Close False
Next

'Save and close workbooks
wbPub.Close True
wbPri.Close True

End Sub[/vba]

[jo15765]

The top portion of your code, I had a few questions about...Can you elaborate the explanation a little further for me?
[VBA]
'What workbook is this? The one I am opening, the one I am trying to save to?
MyWB = "Test.xlsx" '<===Adjust as required

ReDim MyDirs(50)
' Display the names in that represent directories.
' I am unclear on what this is representing? Do I list out each possible path name of where
' a workbook could be saved as?
MyPath = "C:\Daily\Checked\" ' Set the path.
[/VBA]

[jo15765]

Okay in trying to run the code I discovered what the ReDim MyDirs(50) does...quite an ingenious way to code it!!!!!!

I think the MyWB should be the workbook names...but to me since there is no Array, can I only add one workbook name there, or can I add multiple and just code like:
[VBA]
MyWB = "WB1", "WB2", "WB3" etc etc
[/VBA]

And in turn it will search for each of those workbook names in teh subsequent folders?

[mdmackillop]

You can create an array of names and refer to these by index number or loop through them

[vba]Dim myWB()
myWB = Array("WB1", "WB2", "WB3")
MsgBox myWB(1)
[/vba]

[jo15765]

One more thing and I think I'll be all set . I have the coding to not save the workbook if Range(A4:A5) are null. So some of the workbooks in myWB Array, may not exist. I have been using this function to check if a workbook exists:
[VBA]
Public Function FileExists(strFullPath As String) As Boolean
On Error GoTo Whoa
If Not Dir(strFullPath, vbDirectory) = vbNullString _
Then FileExists = True
Whoa:
On Error GoTo 0
End Function
[/VBA]

But I can't figure out how to tailor that to check subfolders? It's looking for full path only. Long story short, I now need some way to check the myWB Array and verify that the workbook exists and if it does then copy it to the corresponding Public or Private workbook that's created.

[jo15765]

I am also now getting this debug error when trying to run the above procedure

Run Time Error

Automation Error

The object invoked has disconnected from its clients

[jo15765]

I added a copy statement to the end of each module, and it is working so my code looks like this:
[VBA]
Public Sub NumberOne()
Dim wb As Workbook
Dim View
Dim Rng As Range

View = "Private"

Set wb = Workbooks.Open(Filename:="C:\Monday\Dave\workbook1.xls")
'Function that via DAO imports data from query
Call GetAccessDataDAO
'Function that will put the Date column in the format of yyyymmdd
Call Format_Date
'Function that will delete the header rows from the worksheets
Call D_Headers

'Function that if no "new" data was imported will not save the workbook
Set wb = ActiveWorkbook
Set Rng = Range("A3:A4")

If Application.CountA(Rng) = 0 Then
wb.Close
Else
Const sPath As String = "C:\Daily\Checked\"
Dim avsFolder As Variant
Dim i As Long

avsFolder = "Checked"

MkDir sPath & avsFolder
wb.SaveAs Filename:="C:\Daily\Checked\" & wb.Name
End If
Dim k As Long

k = 2

With Sheets(k)
Sheets(k).Select
If View = "Public" Then
Workbooks("Master_Public_Files.xls").Worksheets(k).Copy After:=wb.Sheets(1)
Else
Workbooks("Master_Private_Files.xls").Worksheets(k).Copy After:=wb.Sheets(1)
End If
End With
End Sub
[/VBA]