Help with VBA to process 10k + files each with mulitple sheets

Good Afternoon,

To begin with, I want to thank all of you as you have already been a huge help in how far I have gotten. I would not have gotten here with out you.


Now my problem if you would please allow me to beg for help on.

I have 10,000+ excel workbooks, and each have multiple sheets (there a total of 12 sheets, but not all sheets are in all workbooks).

I need to set all sheets to a known print area as well as set each sheet to portrait format and set the printing default to print all columns on one page with the script ending in saving the file/workbook.

Ideally I would then like the script to move on to the next file/workbook in the folder.

The code below is what I have so far, but it is not working, and I can not figure out why or where. However it complies with no errors.

So again, if you will please allow me, I am begging for help. This is for work, and I really don't want to have to go through all the sheets one by one.

I really hope I have explained what I need and am wanting.

Thank you in advance for anything insight you can offer.


*************************************************

Function WorksheetExists(SH As String)
Dim Sht As Worksheet
WorksheetExists = False
For Each Sht In ActiveWorkbook.Worksheets
  If Sht.Name = SH Then
    WorksheetExists = True
    Exit For
  End If
 Next Sht
End Function


Sub print_area()
'
' print_area Macro
'
' Keyboard Shortcut: Ctrl+s
'

      
       
    If WorksheetExists("Tally Board") Then
        Sheets("Tally Board").Select
        Sheets("Tally Board").Activate
        Range("A1:J20").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$J$20"
       With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
    If WorksheetExists("Inmate Location") Then
        Sheets("Inmate Location").Select
        Sheets("Inmate Location").Activate
        Range("A1:E50").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$E$50"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
    If WorksheetExists("Inmate Location A-D") Then
        Sheets("Inmate Location A-D").Select
        Sheets("Inmate Location A-D").Activate
        Range("A1:E50").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$E$50"
       With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
        
    If WorksheetExists("Inmate Location E-G") Then
        Sheets("Inmate Location E-G").Select
        Sheets("Inmate Location E-G").Activate
        Range("A1:E50").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$E$50"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
        
    If WorksheetExists("Activity") Then
        Sheets("Activity").Select
        Sheets("Activity").Activate
        Range("A1:L155").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$L$155"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
        
    If WorksheetExists("Security Check") Then
        Sheets("Security Check").Select
        Sheets("Security Check").Activate
        Range("A1:I110").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$I$110"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
    
    If WorksheetExists("Security Check HU3") Then
        Sheets("Security Check HU3").Select
        Sheets("Security Check HU3").Activate
        Range("A1:I110").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$I$110"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
    
    If WorksheetExists("Security Check HU4") Then
        Sheets("Security Check HU4").Select
        Sheets("Security Check HU4").Activate
        Range("A1:I110").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$I$110"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
    
    If WorksheetExists("Security Check HU16") Then
        Sheets("Security Check HU16").Select
        Sheets("Security Check HU16").Activate
        Range("A1:I110").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$I$110"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
    
    If WorksheetExists("Security Check HU17") Then
        Sheets("Security Check HU17").Select
        Sheets("Security Check HU17").Activate
        Range("A1:I110").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$I$110"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
    
    If WorksheetExists("DVD-CD Check Out") Then
        Sheets("DVD-CD Check Out").Select
        Sheets("DVD-CD Check Out").Activate
        Range("A1:F110").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$F$110"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
         End With
    End If
        
    If WorksheetExists("HU Check Off") Then
        Sheets("HU Check Off").Select
        Sheets("HU Check Off").Activate
        Range("A1:S15").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$S$15"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
        
    If WorksheetExists("SCBA") Then
        Sheets("SCBA").Select
        Sheets("SCBA").Activate
        Range("A1:G20").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$G$20"
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    
                
    If WorksheetExists("Recreation") Then
        Sheets("Recreation").Select
        Sheets("Recreation").Activate
        Range("A1:G260").Select
           ActiveSheet.PageSetup.PrintArea = "$A$1:$G$260"
        Range("F274").Select
        With ActiveSheet.PageSetup
           .PaperSize = xlPaperLetter
           .Orientation = xlPortrait
           .FitToPagesWide = 1
           .FitToPagesTall = False
        End With
    End If
    

End Sub

**********************************************

Welcome to the board.

Please use code tags around any code you post.

Change the path as required.

Originally Posted by Tinbendr

Welcome to the board.

Please use code tags around any code you post.

Change the path as required.

David,

I want to thank you again for the code you wrote. It is with great regret that I must report the code was not working. The error I was getting, is as follows:

Run-time error '1004':'01012009.xls could not be found. Check the spelling of the file name, and verify that the file location is correct.
If you are trying to open the file from your list of most recently used files, make sure that the file has not been renamed, moved, or deleted"

I did tweak the code a bit, in that I was given more files which increased the different sheets we have. Also, the workbooks in question are .xls files and I am working in excel 2010.


The code I tweaked is below:

Sub print_area()
'
' print_area Macro
'
' Keyboard Shortcut: Ctrl+s
    Dim WS As Worksheet
    Dim LastRow As Long
    Dim MyPath As String
    Dim MyFile As String
    Dim WB As Workbook
    Dim SH As Worksheet

    Set WS = ActiveSheet

    With WS
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    'Change as required
    MyPath = "C:\Users\darin.miller\Documents\__Temp\Gray v COR\SCF 2 #9\Security Check Logs 2009-2011\Security Check Logs 2009\01 January 2009"

    'Fetch the first filename.
    MyFile = Dir(MyPath & "\*.xls")

    If MyFile <> "" Then
        Do
            'Record workbook name
            WS.Range("A" & LastRow) = MyFile
            LastRow = LastRow + 1
            Set WB = Workbooks.Open(MyFile, False)

            For Each SH In WB.Worksheets
                'Default setting for each sheet.
                With SH.PageSetup
                    .PaperSize = xlPaperLetter
                    .Orientation = xlPortrait
                    .FitToPagesWide = 1
                    .FitToPagesTall = False
                End With

                Select Case SH.Name
                    Case "Tally Board"
                        SH.PageSetup.PrintArea = "$A$1:$J$20"

                    Case "Inmate Location"
                        SH.PageSetup.PrintArea = "$A$1:$E$50"

                    Case "Inmate Location A:D"
                        SH.PageSetup.PrintArea = "$A$1:$E$50"

                    Case "Inmate Location E:G"
                        SH.PageSetup.PrintArea = "$A$1:$E$50"

                    Case "Activity"
                        SH.PageSetup.PrintArea = "$A$1:$L$155"

                    Case "Security Check"
                        SH.PageSetup.PrintArea = "$A$1:$I$110"

                    Case "Security Check HU3"
                        SH.PageSetup.PrintArea = "$A$1:$I$110"

                    Case "Security Check HU4"
                        SH.PageSetup.PrintArea = "$A$1:$I$110"

                    Case "Security Check HU5"
                        SH.PageSetup.PrintArea = "$A$1:$I$110"

                    Case "Security Check HU6"
                        SH.PageSetup.PrintArea = "$A$1:$I$110"

                    Case "Security Check HU7"
                        SH.PageSetup.PrintArea = "$A$1:$I$110"

                    Case "Security Check HU16"
                        SH.PageSetup.PrintArea = "$A$1:$I$110"

                    Case "Security Check HU17"
                        SH.PageSetup.PrintArea = "$A$1:$I$110"

                    Case "DVD:CD Check Out"
                        SH.PageSetup.PrintArea = "$A$1:$F$110"

                    Case "HU Check Off"
                        SH.PageSetup.PrintArea = "$A$1:$S$15"

                    Case "SCBA"
                        SH.PageSetup.PrintArea = "$A$1:$G$20"

                    Case "Recreation"
                        SH.PageSetup.PrintArea = "$A$1:$G$260"

                    Case "Release Log"
                        SH.PageSetup.PrintArea = "$A$1:$K$75"

                    Case "Headcount"
                        SH.PageSetup.PrintArea = "$A$1:$J$55"
                End Select
            
            Next
            WB.Close True
            'Get next file.
            MyFile = Dir
        Loop Until MyFile = ""
        End If
    End Sub

Update, this project just went from 10k files to about 35,000 plus files.

And I am sorry I failed to include the [code] tags when I first posted. I believe I have corrected this oversight.

I hope i am able to find help with my problem on here.

Change the open statement to

Set WB = Workbooks.Open(MyPath & "\" & MyFile, False)

David,

You have no idea how great you are looking to my boss. Thank you. And yes I am clearly stating that you and this site are the ones solving this for me.

However, I have discovered another problem that I did not even consider. The files we are working with come from the County, and a few of them are secured with protection to some degree. When going through a few of those before I started begging for help, the files allowed me to make changes that your script make and then save with no problem.

But when I run your script, it is giving me the following error:

"Security Warning

Some active content has been disabled. click for more details."

Clicked "Enable Content" and i get a message dialog box stating "Your computer is not authorized to open this file".

Now is there away to program in some sort of work around, and if no, would it be possible to program in for the file to be moved to a set folder to allow me to go through them manually? (Sad but it looks like there will be a lot of them).


And there also appears to be a problem with some of the sheets when converting to pdf. Not all of the sheets are "printing" to pdf with all columns to fit a page. Any idea's? I did double check the print ranges and page setup, and they appear to still be correct.

And I gave you positive "reputation" point for all you have helped me with.

You can try,
Options, Trust Center, Trust Center Settings, Macro Settings, Enable all macros.

Then select, Trusted Locations and add the path you are using to store the files.

Exit Excel, then start again.

If this doesn't help, I suggest you start a new thread on the Security warning.

As far as segregating the files that give a security warning, I'm afraid I'm at a loss. I just don't have much experience with that.

I'm afraid I can't help with the printing PDF problem either.

Sorry I couldn't help more.