Excel VBA (Footer)

Please help with this issue.  I have 120 files in a folder and would need to add standard footer to one specifc tab on each spreadsheet on all files within the folder.  The footer should be added to the tab called "Destination" on all files
Is there a way for a macro to do this?
Portland--OR.xls
PUGET-SOUND.xls
ArisaAnsarAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

SiddharthRoutCommented:
What do you want to add in Footer?

Sid
ArisaAnsarAuthor Commented:
Thank you, thank you.

Here is the message for the footer:

Note: Account details reports were posted to the BOM Portal and Reports Portal in the Specials section.  Reports are called:
Connect-Edelivery - New Accts Enrolled Mar 15-Mar 31
Connect-SAC - New Accts With SAC Mar 15-Mar 31
Connect-FreeForever IRA-Mar 1-Mar 31
nutschCommented:
Try something like this, after having updated the footer info, and the folder.

Thomas

Sub Macro4()

Application.ScreenUpdating = False 'disable screen updating to avoid screen flashing
Dim FileName As String, intFileCount As Long, strFullPath As String
Const strPath As String = "C:\TEMP\" 'update to your file path
Dim myArr, i As Long
Dim wbk1 As Workbook, wbk2 As Workbook

FileName = Dir(strPath & "\*.xls") '"\" & myArr(i) & "\*.xls")
Do While FileName <> ""
   intFileCount = intFileCount + 1
       
    strFullPath = strPath & "\" & FileName
    
    Set wbk2 = Workbooks.Open(strFullPath)
    
    On Error Resume Next
    
    With wbk2.Sheets("Destination").PageSetup
        .LeftFooter = ""
        .CenterFooter = "My standard footer here"
        .RightFooter = ""
    End With
    
    wbk2.Close (True)
    Set wbk2 = Nothing
'******************************************************************

    FileName = Dir
Loop
    
End Sub

Open in new window

10 Tips to Protect Your Business from Ransomware

Did you know that ransomware is the most widespread, destructive malware in the world today? It accounts for 39% of all security breaches, with ransomware gangsters projected to make $11.5B in profits from online extortion by 2019.

zorvek (Kevin Jones)ConsultantCommented:
Change the constants to suit your situation:

Public Sub ProcessFiles()

    Dim FileName As String
   
    Const Folder = "C:\Documents and Settings\Login Name\Desktop\File Folder"
   
    FileName = Dir(Folder & "\*.xls")
    Do While Len(FileName) > 0
        Workbooks.Open Folder & "\" & FileName
        ActiveWorkbook.Sheets("Destination").Activate
        With ActiveSheet.PageSetup
            .LeftFooter = "Left"
            .CenterFooter = "Center"
            .RightFooter = "Right"
        End With
        ActiveWorkbook.Close True
        FileName = Dir
    Loop

End Sub

Kevin
nutschCommented:
with your footer info

Sub Macro4()

Application.ScreenUpdating = False 'disable screen updating to avoid screen flashing
Dim FileName As String, intFileCount As Long, strFullPath As String
Const strPath As String = "C:\TEMP\" 'update to your file path
Dim myArr, i As Long
Dim wbk1 As Workbook, wbk2 As Workbook

FileName = Dir(strPath & "\*.xls") '"\" & myArr(i) & "\*.xls")
Do While FileName <> ""
   intFileCount = intFileCount + 1
       
    strFullPath = strPath & "\" & FileName
    
    Set wbk2 = Workbooks.Open(strFullPath)
    
    On Error Resume Next
    
    With wbk2.Sheets("Destination").PageSetup
        .LeftFooter = ""
        .CenterFooter = "Note: Account details reports were posted to the BOM Portal and Reports Portal in the Specials section.  Reports are called:" & vbCrLf & _
                            "Connect-Edelivery - New Accts Enrolled Mar 15-Mar 31" & vbCrLf & _
                            "Connect-SAC - New Accts With SAC Mar 15-Mar 31" & vbCrLf & _
                            "Connect-FreeForever IRA-Mar 1-Mar 31"
        .RightFooter = ""
    End With
    
    wbk2.Close (True)
    Set wbk2 = Nothing
'******************************************************************

    FileName = Dir
Loop
    
End Sub

Open in new window

SiddharthRoutCommented:
Try this.

I have amended your earlier code.

Const MyFolder As String = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports Test\"

Sub Sample()
    Dim wb As Workbook, ws As Worksheet
    Dim LastRow As Long, DestRow As Long
    Dim StrFile As String
    Dim msgFooter As String
    
    '~~> Footer Message
    msgFooter = "Note: Account details reports were posted to the BOM Portal and Reports Portal in the Specials section.  Reports are called:" & vbNewLine & _
                "Connect-Edelivery - New Accts Enrolled Mar 15-Mar 31" & vbNewLine & _
                "Connect-SAC - New Accts With SAC Mar 15-Mar 31" & vbNewLine & _
                "Connect-FreeForever IRA-Mar 1-Mar 31"
     
    
    StrFile = Dir$(MyFolder & "*.xls")
    
    Do While Len(StrFile)
        Set wb = Workbooks.Open(MyFolder & StrFile)
        Set ws = Sheets("DESTINATION")
        
        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
        DestRow = LastRow + 3
        
        ws.Range("D" & DestRow) = "Complex Totals"
        ws.Range("G" & DestRow).Formula = "=SUM(G6:G" & DestRow - 1 & ")"
        ws.Range("G" & DestRow).Copy
        ws.Range("T" & DestRow & ":V" & DestRow & ",P" & DestRow & ":R" & DestRow & ",M" & DestRow & _
        ":N" & DestRow & ",J" & DestRow & ":K" & DestRow & ",H" & DestRow).PasteSpecial Paste:=xlPasteFormulas, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
        ws.Range("I" & DestRow).Formula = "=H" & DestRow & "/G" & DestRow
        ws.Range("L" & DestRow).Formula = "=(K" & DestRow & "/J" & DestRow & ")-$I$" & DestRow
        ws.Range("O" & DestRow).Formula = "=(N" & DestRow & "/M" & DestRow & ")-$I$" & DestRow
        ws.Range("S" & DestRow).Formula = "=(Q" & DestRow & "+R" & DestRow & ")/P" & DestRow
        ws.Range("W" & DestRow).Formula = "=(U" & DestRow & "+V" & DestRow & ")/T" & DestRow
        ws.Range("X" & DestRow).Formula = "=O" & DestRow & "+S" & DestRow & "+W" & DestRow
        
        ws.Rows(DestRow).NumberFormat = "0"
        ws.Range("I" & DestRow & ",L" & DestRow & ",O" & DestRow & ",S" & DestRow & _
        ",W" & DestRow & ",X" & DestRow).NumberFormat = "0.00%"
        
        '~~> Add the relevent Text to the Footer
        With ws.PageSetup
            .CenterFooter = msgFooter
        End With
    
        Application.StatusBar = " File " & wb.Name & " is being processed..."
        wb.Close savechanges:=True
        StrFile = Dir
    Loop
    
    MsgBox "Done"
    
    Set ws = Nothing
    Set wb = Nothing
End Sub

Open in new window


Sid
zorvek (Kevin Jones)ConsultantCommented:
With the desired footer in place:

Public Sub ProcessFiles()

    Dim FileName As String
   
    Const Folder = "C:\Documents and Settings\Login Name\Desktop\File Folder"
   
    FileName = Dir(Folder & "\*.xls")
    Do While Len(FileName) > 0
        Workbooks.Open Folder & "\" & FileName
        ActiveWorkbook.Sheets("Destination").Activate
        With ActiveSheet.PageSetup
            .CenterFooter = "Note: Account details reports were posted to the BOM Portal and Reports Portal in the Specials section.  Reports are called:" & vbCrLf & "Connect-Edelivery - New Accts Enrolled Mar 15-Mar 31" & vbCrLf & "Connect-SAC - New Accts With SAC Mar 15-Mar 31" & vbCrLf & "Connect-FreeForever IRA-Mar 1-Mar 31"
        End With
        ActiveWorkbook.Close True
        FileName = Dir
    Loop

End Sub

Kevin
SiddharthRoutCommented:
Whoa!

Sid
ArisaAnsarAuthor Commented:
Sid
I'm getting the following message " Unable to set the centerfooter property of the page setup class."

When I Debug, this code is highlighted:

            .CenterFooter = msgFooter


Entire code in the file is:

Option Explicit

Const MyFolder As String = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports Test\"

Sub Sample()
    Dim wb As Workbook, ws As Worksheet
    Dim LastRow As Long, DestRow As Long
    Dim StrFile As String
    Dim msgFooter As String
   
    '~~> Footer Message
    msgFooter = "Note: Account details reports were posted to the BOM Portal and Reports Portal in the Specials section.  Reports are called:" & vbNewLine & _
                "Connect-Edelivery - New Accts Enrolled Mar 15-Mar 31" & vbNewLine & _
                "Connect-SAC - New Accts With SAC Mar 15-Mar 31" & vbNewLine & _
                "Connect-FreeForever IRA-Mar 1-Mar 31"
     
   
    StrFile = Dir$(MyFolder & "*.xls")
   
    Do While Len(StrFile)
        Set wb = Workbooks.Open(MyFolder & StrFile)
        Set ws = Sheets("DESTINATION")
       
        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
        DestRow = LastRow + 3
       
        ws.Range("D" & DestRow) = "Complex Totals"
        ws.Range("G" & DestRow).Formula = "=SUM(G6:G" & DestRow - 1 & ")"
        ws.Range("G" & DestRow).Copy
        ws.Range("T" & DestRow & ":V" & DestRow & ",P" & DestRow & ":R" & DestRow & ",M" & DestRow & _
        ":N" & DestRow & ",J" & DestRow & ":K" & DestRow & ",H" & DestRow).PasteSpecial Paste:=xlPasteFormulas, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       
        ws.Range("I" & DestRow).Formula = "=H" & DestRow & "/G" & DestRow
        ws.Range("L" & DestRow).Formula = "=(K" & DestRow & "/J" & DestRow & ")-$I$" & DestRow
        ws.Range("O" & DestRow).Formula = "=(N" & DestRow & "/M" & DestRow & ")-$I$" & DestRow
        ws.Range("S" & DestRow).Formula = "=(Q" & DestRow & "+R" & DestRow & ")/P" & DestRow
        ws.Range("W" & DestRow).Formula = "=(U" & DestRow & "+V" & DestRow & ")/T" & DestRow
        ws.Range("X" & DestRow).Formula = "=O" & DestRow & "+S" & DestRow & "+W" & DestRow
       
        ws.Rows(DestRow).NumberFormat = "0"
        ws.Range("I" & DestRow & ",L" & DestRow & ",O" & DestRow & ",S" & DestRow & _
        ",W" & DestRow & ",X" & DestRow).NumberFormat = "0.00%"
       
        '~~> Add the relevent Text to the Footer
        With ws.PageSetup
            .CenterFooter = msgFooter
        End With
   
        Application.StatusBar = " File " & wb.Name & " is being processed..."
        wb.Close savechanges:=True
        StrFile = Dir
    Loop
   
    MsgBox "Done"
   
    Set ws = Nothing
    Set wb = Nothing
End Sub
SiddharthRoutCommented:
Ok Let me test it with a sample file.

Sid
ArisaAnsarAuthor Commented:
Can you fix so that it is in the Left section of the footer?
SiddharthRoutCommented:
Sure no probs

Sid
zorvek (Kevin Jones)ConsultantCommented:
Each part of the header and footer properties can hold a maximum of only 253 characters. Trim a few characters out and you will be OK.

Kevin
zorvek (Kevin Jones)ConsultantCommented:
11 characters removed should do it.

Kevin
SiddharthRoutCommented:
Ok The error is because you have exceeded the maximum number of characters in the footer.

Please reduce the text size,

Sid
SiddharthRoutCommented:
Beaten again :(

Sid
SiddharthRoutCommented:
Also change this part of the code

        With ws.PageSetup
            .CenterFooter = msgFooter
        End With

to

        With ws.PageSetup
            .LeftFooter = msgFooter
        End With

Open in new window


Sid
ArisaAnsarAuthor Commented:
Its working.
How do I remove the extra line breaks in the footer?  It should display as follows.

Note: Account details reports were posted to the BOM and Reports Portal in the Specials section.  Reports are called:
Connect Edelivery-New Accts Enrolled Mar 15-Mar 31
Connect SAC-New Accts With SAC Mar 15-31
Connect FreeForever IRA-Mar 1-31
SiddharthRoutCommented:
Try this

msgFooter = "Note: Account details reports were posted to the BOM and Reports Portal in the Specials section." & Chr(10) & _
            "Reports are called:" & Chr(10) & _
            "Connect Edelivery-New Accts Enrolled Mar 15-Mar 31" & Chr(10) & _
            "Connect SAC-New Accts With SAC Mar 15-31" & Chr(10) & _
            "Connect FreeForever IRA-Mar 1-31"

Open in new window


Sid

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
SiddharthRoutCommented:
The best way is to record a macro and then manually set the footer :)

Sid
ArisaAnsarAuthor Commented:
I'm so amazed that all of you responded so quickly.  Appreciate the efforts very, very much!   I wish I had a million points to distribute to each of you!!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Applications

From novice to tech pro — start learning today.