Add a standard footer to an existing worksheet

[ExcelJAM]

My company has a lengthy confidentiality footer that must be added on every worksheet of every workbook. I often receive existing worksheets where I need to add this footer. Is there a way to quickly/automatically add it without affecting the other existing page set up features (e.g. page orientation, margins, etc.)?

I've searched the forum and found something similar that was answered with a Before_Print Event - however I need to ensure this is on all worksheets, even if they are never printed.

The footer is: Confidential Use Only. Disclose and distribute only to XX employees having a legitimate business need to know. Disclosure outside of XX is prohibited without authorization.

I would like it centered in an 8 pt font with a hard return after each sentence end.

I currently waste a TON of time dealing with this and would greatly appreciate any help anyone can offer.

 

[ExcelJAM]

It does, thanks!

Your mistake was in trying to place it in the ThisWorkBook module of you Personal.xls. This is a pure macro, not an Event procedure. The ThisWorkBook module (like the Sheet modules) is only used for Event procedures. You need to open the VBE and insert a module. That's where the code goes. When you used the macro recorder, that's what it did. Does it now run on all Open WorkBooks??

lenze

 

[ExcelJAM]

lenze -

You still out there? The macro you gave me is a big hit!! Is there any way to to select a group of worksheets and run the macro (once) and have it apply to all of them?

Thanks,
JAM

 

[lenze]

lenze -

You still out there? The macro you gave me is a big hit!! Is there any way to to select a group of worksheets and run the macro (once) and have it apply to all of them?

Thanks,
JAM

Of Course. Can you be more specific? Do you mean manually selecting sheets and running only on that selection, or do you mean pre-defined sheets in your workbook? Are there different Workbooks with different sheet names? It just depends. It can be done, but it may be more trouble than it's worth (IMO). Anyway, I will be off-line most of tomorrow (Thursday), but will check back as soon as I can.

lenze

BTW: Did you get the font size fixed?

 

[ExcelJAM]

Generally if I'm adding the footer to one worksheet in a workbook, then I need to add it to all the worksheets in that workbook. The workbook names and sheet names will all vary, since I'm working with files provided by other users.

So if we could set it up to run for the entire active workbook (all at once) that would be great. But, manually selecting the sheets and then running it for the group selected would work fine too. Currently I have to run it in each individual worksheet, if I select a group of worksheets and run the macro it only adds the footer to the first sheet selected.

Thanks again for your help! My Dept. thinks I'm the genius! (Despite what I tell them)

Thanks,
JAM

Of Course. Can you be more specific? Do you mean manually selecting sheets and running only on that selection, or do you mean pre-defined sheets in your workbook? Are there different Workbooks with different sheet names? It just depends. It can be done, but it may be more trouble than it's worth (IMO). Anyway, I will be off-line most of tomorrow (Thursday), but will check back as soon as I can.

lenze

BTW: Did you get the font size fixed?

 

[ExcelJAM]

lenze -

Forgot to tell you - YES I got the font size to work too! That was a great resource you directed me to.

JAM

 

[Gunswick]

this macro will open all workbooks in a directory, Then open each sheet, do your footer code, close and save the workbook. do a test first in a practise directory so you know it works ok.

Sub GetDataAllBks()
'http://www.mrexcel.com/archive2/41500/48036.htm
Dim count As Integer
Dim Path
Dim ws As Worksheet
'On Error GoTo exitloop
'& Chr(13) & this adds a new line in a message box.
'the Path input box has a backslash added onto the end of the address to allow it to work.
Path = InputBox("Please Enter Folder Directory to Search, e.g. C:\Temp\Forecasts" & Chr(13) & "You can navigate to it & copy paste the address bar here") & "\"
If Path = "" Or Path = "\" Then Exit Sub
FileContains = InputBox("Enter part of filename to search for - not case sensitive" & Chr(13) & "Leave blank to open all books in the directory")
'nextfile = Dir(Path & "*.xls") 'finds all files ending in .xls
'nextfile = Dir(Path & "*WK31*") 'finds book names containing WK31 ;play around with asterisk position
reminder = InputBox("Would you like a message after x number of Books?" & Chr(13) & "Enter number or leave blank for no message")
'If Path Or FileContains Or reminder = vbCancel Then Exit Sub
nextfile = Dir(Path & "*" & FileContains & "*")
' open book
On Error Resume Next
Workbooks.Open Filename:=Path & nextfile
' Your Code Here **********************************************************
 
'YOUR CODE HERE
 
For Each ws In Worksheets
ActiveSheet.PageSetUp.CenterFooter = "xxxxx" & Chr(10) & "yyyyy" & Chr(10) & "zzzzz"
Next ws
 
 
count = 1 'starts a counter so you can have a message open when say 5 books have been done.
ActiveWorkbook.Close SaveChanges:=True
'Your Code Finished ********************************************************
Do While nextfile <> "" 'Or nextfile <> ThisWorkbook 'nextfile <> "OPEN ALL SUBS AND PRINT.xls" 'Start the loop.
nextfile = Dir
If nextfile = "" Then Exit Sub
' open book
Workbooks.Open Filename:=Path & nextfile
' Your Code Here **********************************************************
 
 
'YOUR CODE HERE
 
For Each ws In Worksheets
ActiveSheet.PageSetUp.CenterFooter = "xxxxx" & Chr(10) & "yyyyy" & Chr(10) & "zzzzz"
Next ws

count = count + 1 'increases the counter so you can have a message open when say 5 books have been done.
ActiveWorkbook.Close SaveChanges:=True
'Your Code Finished ********************************************************
 
If count = reminder Then
MsgBox "Thats " & reminder & " Books Done...!"
count = 0 'resets counter to zero, so that it will do another reminder
End If
Loop
'exitloop:
End Sub

 

[ExcelJAM]

I have the following macro that I use to add a footer with a confidentiality statement to the active tab (worksheet) in the open workbook:

Sub AddFooter()
ActiveSheet.PageSetUp.CenterFooter = "xxxxx" & Chr(10) & "yyyyy" & Chr(10) & "zzzzz"
End Sub

It works great, but I have to go to each tab in a workbook and run it. I want to update the macro so it will run for all tabs in the active workbook. Can anyone help me with this?

I tried to do this when I got help from the forum to create the macro but got one reply that I didn't understand and gave up due to time limitations.

Thanks for any help you can offer!

 

[lenze]

Hi ExcelJAM. Try this, untested. Will test tomorrow.

Sub AddFooter()
Dim ws as WorkSheet
For Each ws in WorkSheets
ws.PageSetUp.CenterFooter = "xxxxx" & Chr(10) & "yyyyy" & Chr(10) & "zzzzz"
Next ws
End Sub

lenze

 

[ExcelJAM]

Lenze -

Works perferctly, thanks so much!!

- Joanne