PDA

View Full Version : Solved: Combining macros to open and run on multiple protected worksheets



pireng
01-15-2009, 09:39 AM
I have numerous spreadsheets with password protected worksheets that I need to remove some shading from. I have macros that work for each step 1) un-protect the worksheet, 2) remove the shading, 3) re-protect the worksheet, also have a macro that calls macros 1-3, but there are far too many to have to open each one separatly and copy the macros to each one. I would like to be able to browse to a folder and select multiple files and have it go from there... what do i need to make this work? I have a macro that will let me browse to a folder and select multiple files and then opens them, but I cant get the rest of the macros to work within it. I have no VBA experience and have come up with these macros by searching through forums and adapting them to my files... so I'm sure there is a better/easier way... Thanks for any help.

Module1-This works to unprotects the worksheet

Sub UnprotectAllSheets()
Dim anySheet As Worksheet

For Each anySheet In ThisWorkbook.Worksheets
anySheet.Unprotect Password:="password"
Next
End Sub


Module2-This works to reprotect the worksheet

Sub ProtectAllSheets()
Dim anySheet As Worksheet

For Each anySheet In ThisWorkbook.Worksheets
anySheet.Protect Password:=?password?
Next
End Sub


Module3-This works to remove the shading

Sub UNSHADE()
'
' UNSHADE Macro
'

'
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("TS1", "TS2", "TS3", "TS4", "TS5", "TS6", "TS7", "TS8", "TS9", "TS10", _
"TS11", "TS12", "TS13", "TS14", "TS15", "TS16", "TS17", "TS18", "TS19", "TS20", "TS21", _
"TS22", "TS23", "TS24", "TS52")).Select
Sheets("TS52").Activate
Sheets(Array("TS25", "TS26", "TS27", "TS28", "TS29", "TS30", "TS31", "TS32", "TS33", _
"TS34", "TS35", "TS36", "TS37", "TS38", "TS39", "TS40", "TS41", "TS42", "TS43", "TS44", _
"TS45", "TS46", "TS47", "TS48", "TS49")).Select Replace:=False
Sheets(Array("TS50", "TS51")).Select Replace:=False
Columns("K:S").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("D6").Select
Sheets(Array("TS1", "TS2", "TS3", "TS4", "TS5", "TS6", "TS7", "TS8", "TS9", "TS10", _
"TS11", "TS12", "TS13", "TS14", "TS15", "TS16", "TS17", "TS18", "TS19", "TS20", "TS21", _
"TS22", "TS23", "TS24", "TS25")).Select
Sheets("TS1").Activate
Sheets(Array("TS26", "TS27", "TS28", "TS29", "TS30", "TS31", "TS32", "TS33", "TS34", _
"TS35", "TS36", "TS37", "TS38", "TS39", "TS40", "TS41", "TS42", "TS43", "TS44", "TS45", _
"TS46", "TS47", "TS48", "TS49", "TS50")).Select Replace:=False
Sheets(Array("TS51", "TS52")).Select Replace:=False
Sheets("TS1").Select
End Sub


Module4-This works to run all three macros once you open the worksheet

Sub CallMyMacros()
Call UnprotectAllSheets
Call UNSHADE
Call ProtectAllSheets
End Sub


Module5- This does not work, but should go to the folder and work globally on the files, but gives an error that the first one is protected

Sub ProcessAll()
Dim Wb As Workbook, sFile As String, sPath As String
Dim itm As Variant
Dim strFileNames As String

sPath = ?C:\fix timecards\?

? Retrieve the current xl files in directory
sFile = Dir(?C:\fix timecards\? & ?*.xls?)
Do While sFile <> ??
strFileNames = strFileNames & ?,? & sFile
sFile = Dir()
Loop

? Open each file found
For Each itm In Split(strFileNames, ?,?)
If itm <> ?? Then
Set Wb = Workbooks.Open(sPath & itm)
Call CallMyMacros ?this runs my macro from above
Wb.Close True
End If
Next itm

End Sub


Module6-This one works to let you browse to any folder and open them, but I don?t know how to put my other macros into it to make it work.

Sub loopyarray()

Dim filenames As Variant

' set the array to a variable and the True is for multi-select
filenames = Application.GetOpenFilename(, , , , True)

counter = 1

' ubound determines how many items in the array
While counter <= UBound(filenames)

'Opens the selected files
Workbooks.Open filenames(counter)

' displays file name in a message box
MsgBox filenames(counter)

'increment counter
counter = counter + 1

Wend
End Sub

lucas
01-15-2009, 11:49 AM
If you create an addin with the code you have you can run it on any workbook you open.

pireng
01-15-2009, 12:12 PM
Thank you for the reply lucas... I will have to find and example because i have no vba experience and that goes right over my head :dunno ... my dos and fortran classes back in the day haven't helped much... </IMG>

lucas
01-15-2009, 01:27 PM
Try this, I have added your macro's to the file. All references to thisworkbook have been changed to activeworkbook.

Open the file and go to file-saveas and in the save as type drop down select addin *.xla

Then when it's saved, close and open a blank excel file and from tools select addins and put a check next to the addin should be named "example"

now close excel and open one of the files you want to run your code on. A new menu item next to help should appear that says. MyMenu. Select wizards and then run the one that says "Run my macro's"

The menu maker is versitile and I use it in all of my addins.

Not sure which version of excel you are running......I use 2003

pireng
01-15-2009, 03:03 PM
hi lucas... I am running 2007 version... I got the MyMenu installed and tried it... it ran thru the file and removed the shading but a "compile error" - "variable not defined" stops it... and it looks like it does not reprotect the workbook...

Once this works... will it proceed to fix all open workbooks or is this a one file at a time process???

thanks for your help...

EDIT: I fixed the compile error, i think..., it runs to the end now, but does not reprotect the first tab or sheet.

pireng
01-15-2009, 03:29 PM
How can i make this work on a folder of files and not just one at a time...

lucas
01-15-2009, 04:36 PM
I'm sorry I missed that very important point.

Maybe you should put the call to the next procedure in each module. In other words, have your first call be to the macro that unprotects the sheet, then at the end of that macro call the unshade....at the end of the unshade call the protect, etc.

In your module 6, right after this line:
Workbooks.Open filenames(counter)
you should be able to call your first macro, the macro to unprotect......

pireng
01-16-2009, 07:22 AM
thanks... i have tried to place the calls in that module... but not knowing the proper syntax... i can't get it to work...

lucas
01-16-2009, 07:24 AM
Have you tried combining your 3 macro's into one. In other words just add the unprotect code to the top of the unshade macro and the protect code to the bottom of the unshade macro. Once you get that to work maybe I can help you figure out how to call it.

pireng
01-16-2009, 07:41 AM
yes i have been... but its pretty much trial and error...
thank you for your help thus far... i'll keep playing with it...

JailDoctor
01-16-2009, 10:48 AM
Notice in module 5 you mispelled the second to last line and wrote

Next itm
End Sub

It should be Next itEm
You forgot the letter E. Very likely this is the cause of the error you get.

lucas
01-16-2009, 03:49 PM
I finally had a minute to look at this. This will allow you to browse to a folder, pick certain files and in this case clear the contents of range B2:B20. You will have to replace that part in the code with your unprotect-unshade-reprotect code.

I would experiment with a couple of files with data in B2:B20 till you know you have it working, then I would use a copy of a couple of your files to implement your code and I would open and unprotect them until you get the formatting part working, then I would eventually include the unprotect/protect code.

Hope this helps.

Option Explicit
Sub AmendFiles()
Dim Wkb As Workbook
Dim WS As Worksheet
Dim counter As Long
Dim filenames As Variant
Application.ScreenUpdating = False
' set the array to a variable and the True is for multi-select
filenames = Application.GetOpenFilename(, , , , True)
counter = 1
' ubound determines how many items in the array
While counter <= UBound(filenames)
'Opens the selected files
Workbooks.Open filenames(counter)
Set Wkb = ActiveWorkbook
For Each WS In Wkb.Worksheets
'The next line is where you would put your other macro
'to do whatever to the sheet that is open
'this is where you would put your unprotece, unshade, etc. code.
WS.Range("B2:B20").ClearContents
Next WS
Wkb.Close True
counter = counter + 1
Wend
Application.ScreenUpdating = True
MsgBox "Operation Complete"
End Sub

pireng
01-16-2009, 03:59 PM
thanks... i'll give it a shot... i'm not sure on how to lump the three together yet but i'll try.... thanks again.!

lucas
01-16-2009, 04:03 PM
If you're not going to do this operation on every sheet you will need to change this part:
For Each WS In Wkb.Worksheets


It currently operates on all sheets in the workbooks that you open.

lucas
01-16-2009, 04:07 PM
Instead of the array in your unshade code you might want to do something like this in your code:
For Each WS In Wbk.Worksheets
Select Case WS.Name
Case "A_datanew", "A_General", "A_ISPACEMONTH", "A_ISPACEYEAR"
'these are the sheets names which shouldn't be copied above
Case Else
'run your code
WS.Range("B2:B20").ClearContents
End Select

In other words point out the ones you don't want the code run on.

pireng
01-20-2009, 09:04 AM
Lucas... I'm getting close, but not quite getting it yet... I have worked with your code and can now open several files, unprotect them and remove the shading... but it doesn't re-protect them... the macro runs without error, but fails to re-protect the files... can you look at what i have come up with..(without laughing) and tell me where i have went wrong...

I have not tried to refine the unshade code yet... thank you for your help...



Option Explicit
Sub AmendFiles()
Dim Wkb As Workbook
Dim WS As Worksheet
Dim counter As Long
Dim filenames As Variant
Application.ScreenUpdating = False
' set the array to a variable and the True is for multi-select
filenames = Application.GetOpenFilename(, , , , True)
counter = 1
' ubound determines how many items in the array
While counter <= UBound(filenames)
'Opens the selected files
Workbooks.Open filenames(counter)
Set Wkb = ActiveWorkbook
For Each WS In Wkb.Worksheets
WS.Unprotect Password:="password"
Next WS
'
' UNSHADE Macro
'
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("TS1", "TS2", "TS3", "TS4", "TS5", "TS6", "TS7", "TS8", "TS9", "TS10", _
"TS11", "TS12", "TS13", "TS14", "TS15", "TS16", "TS17", "TS18", "TS19", "TS20", "TS21", _
"TS22", "TS23", "TS24", "TS52")).Select
Sheets("TS52").Activate
Sheets(Array("TS25", "TS26", "TS27", "TS28", "TS29", "TS30", "TS31", "TS32", "TS33", _
"TS34", "TS35", "TS36", "TS37", "TS38", "TS39", "TS40", "TS41", "TS42", "TS43", "TS44", _
"TS45", "TS46", "TS47", "TS48", "TS49")).Select Replace:=False
Sheets(Array("TS50", "TS51")).Select Replace:=False
Columns("K:S").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("D6").Select
Sheets(Array("TS1", "TS2", "TS3", "TS4", "TS5", "TS6", "TS7", "TS8", "TS9", "TS10", _
"TS11", "TS12", "TS13", "TS14", "TS15", "TS16", "TS17", "TS18", "TS19", "TS20", "TS21", _
"TS22", "TS23", "TS24", "TS25")).Select
Sheets("TS1").Activate
Sheets(Array("TS26", "TS27", "TS28", "TS29", "TS30", "TS31", "TS32", "TS33", "TS34", _
"TS35", "TS36", "TS37", "TS38", "TS39", "TS40", "TS41", "TS42", "TS43", "TS44", "TS45", _
"TS46", "TS47", "TS48", "TS49", "TS50")).Select Replace:=False
Sheets(Array("TS51", "TS52")).Select Replace:=False
Sheets("TS1").Select
Set Wkb = ActiveWorkbook
For Each WS In Wkb.Worksheets
WS.Protect Password:="password"
Next WS
Wkb.Close True
counter = counter + 1
Wend
Application.ScreenUpdating = True
MsgBox "Operation Complete"
End Sub

lucas
01-20-2009, 09:19 AM
Try moving this part:
Set Wkb = ActiveWorkbook
For Each WS In Wkb.Worksheets
WS.Protect Password:="password"
Next WS
Wkb.Close True
to below the wend call......

pireng
01-20-2009, 09:33 AM
after that change the files do not close and are not protected...

lucas
01-20-2009, 10:12 AM
What exactly are you doing to the worksheets once you unprotect them?

pireng
01-20-2009, 10:28 AM
what im trying to accomplish is the unshading of cells K4 thru S35 on tabs TS1 thru TS52 for each file...

lucas
01-20-2009, 10:34 AM
Are there other sheets in the workbook that you want to exclude from the action and if so how many and what are their names.

pireng
01-20-2009, 10:43 AM
there are 5 other tabs:

Summary, Department Hours, Overtime, Leave Form, Log.

lucas
01-20-2009, 11:17 AM
This works in my testing. I included the runme.xls which is the one to open and run the macro and two example files to test on in the attachment:

Option Explicit
Sub AmendFiles()
Dim Wkb As Workbook
Dim ws As Worksheet
Dim counter As Long
Dim filenames As Variant
Application.ScreenUpdating = False
' set the array to a variable and the True is for multi-select
filenames = Application.GetOpenFilename(, , , , True)
counter = 1
' ubound determines how many items in the array
While counter <= UBound(filenames)
'Opens the selected files
Workbooks.Open filenames(counter)
Set Wkb = ActiveWorkbook
For Each ws In Wkb.Worksheets
'The next line is where you would put your other macro
'to do whatever to the sheet that is open
'this is where you would put your unprotece, unshade, etc. code.
Select Case ws.Name
'these are the sheets names which shouldn't be affected
Case "Summary", "Department Hours", "Overtime", "Leave Form", "Log"
Case Else
ws.Unprotect Password:="password"
ws.Range("K4:S35").Interior.ColorIndex = xlNone
ws.Protect Password:="password"
End Select
Next ws
Wkb.Close True
counter = counter + 1
Wend
Application.ScreenUpdating = True
MsgBox "Operation Complete"
End Sub

pireng
01-20-2009, 12:58 PM
Thank you... Thank you... This works on my test directory also... I will mark this thread as solved... Let me know if there is anything I can do for you... need the neighbor kid roughed up for riding his trike on your lawn... tires rotated on the Lexus... just let me know... thanks again

lucas
01-20-2009, 01:04 PM
need the neighbor kid roughed up for riding his trike on your lawn
Hey, I'm not John Mccain....:devil2:

Contribute to the site if you can using the paypal link at the top of the page.