Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Multiple If then statements in VBA excel

Status
Not open for further replies.

idrathermacro

Programmer
Mar 1, 2018
1
0
0
US
Hi - I'm trying to revise a sub macro and I can't figure out the syntax for multiple "if then" statements. I want the macro to place custom headers and footers on all tabs in a workbook, except for certain tabs. Those tabs will be any tabs that end with a ">" or a end with "BoP" or are entitled any of the following: "TOC" or "Cover" or "End" or "Disclaimer" or "Letter of presentation" or "LoP" or "Glossary".

I thought I'd be able to simply add along to the If or with more "or" but apparently not.

Here's the macro:

Sub ApplyHeaderFooter(ByVal control As IRibbonControl)
'
' Apply header/footer to all tabs
'

Dim Check As Integer
Check = MsgBox("This will replace the header/footer contents of the entire workbook. Are you sure you want to continue?", vbYesNoCancel)

If Check = vbYes Then

For Each aSheet In Worksheets
If Right(Trim(aSheet.Name), 1) = ">" Or Right(Trim(aSheet.Name), 3) = "BoP" Or aSheet.Name = "TOC" Or aSheet.Name = "Cover" Or aSheet.Name = "End" Or aSheet.Name = "Disclaimer" Or aSheet.Name = "Letter of presentation" Or aSheet.Name = "LoP" Or aSheet.Name = "Glossary" Then
Else
With aSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&""Arial,Normal""&8&A"
.RightHeader = _
"&""Arial,Normal""&8Draft - Tentative and preliminary" & Chr(10) & "Subject to change"
.LeftFooter = _
"&""Arial,Normal""&8This information is subject in all respects to the terms and conditions of our engagement letter," & Chr(10) & "including restrictions on disclosure of this deliverable to third parties."
.CenterFooter = ""
.RightFooter = "&""Arial,Normal""&8&P"
End With
End If
Next aSheet

End If
 
You don't have to have a 3 foot If Then statement. [bigsmile] You can be overly simple in the implementation:

Code:
Dim CanAddHeaderFooter as Boolean

CanAddHeaderFooter = True

if Right(Trim(aSheet.Name), 1) = ">" Then CanAddHeaderFooter = False
if Right(Trim(aSheet.Name), 3) = "BoP" Then CanAddHeaderFooter = False
'Add more conditions here

if CanAddHeaderFooter = False then Exit Sub

'rest of your code to actually add the header/footer can go here
 
You don't have to have a 3 foot If Then statement. [bigsmile] You can be overly simple in the implementation:

Code:
Dim CanAddHeaderFooter as Boolean

CanAddHeaderFooter = True

if Right(Trim(aSheet.Name), 1) = ">" Then CanAddHeaderFooter = False
if Right(Trim(aSheet.Name), 3) = "BoP" Then CanAddHeaderFooter = False
'Add more conditions here

if CanAddHeaderFooter = False then Exit Sub

'rest of your code to actually add the header/footer can go here
 
You don't have to use [tt]IF[/tt] statements, often [tt]Select Case[/tt] is easier to read:

Code:
[green]'Add more conditions here[/green][blue]
Select Case aSheet.Name
    Case "TOC", "Cover", "End", "Disclaimer", "Letter of presentation", "LoP", "Glossary"
        CanAddHeaderFooter = False
End Select[/blue]

If CanAddHeaderFooter = False then Exit Sub


---- Andy

There is a great need for a sarcasm font.
 
Here are a couple other options...

Code:
    Dim NamesToSkip As String
    NamesToSkip = "*TOC*Cover*End*Disclaimer*Letter of presentation*LoP*Glossary*"

    For Each aSheet In Worksheets
    
        Dim Name As String
        Name = Trim(aSheet.Name)
        
        Dim FormatTab As Boolean
        FormatTab = Not (InStr(NamesToSkip, "*" & Name & "*") > 0 Or Name Like "*>" Or Name Like "*BoP")
        
        If (FormatTab) Then
        
        
        End If

    Next aSheet

and adding the 2 special case options to Andy's solution...

Code:
    For Each aSheet In Worksheets
    
        Dim Name As String
        Name = Trim(aSheet.Name)
        
        Dim FormatTab As Boolean
        Select Case Name
            Case "TOC", "Cover", "End", "Disclaimer", "Letter of presentation", "LoP", "Glossary": FormatTab = False
            Case Else: FormatTab = Not (Name Like "*>" Or Name Like "*BoP")
        End Select
        
        If (FormatTab) Then
        
        End If

    Next aSheet
 
Format the Header and footer in the Template Sheet to look the way you would like it.

Another way to copy the headings and footers is too use the template to set everything the way you want it and then select the Template tab first then all the other tabs that you want to look like it. Go to the Print Preview and close. Deselect the tabs. All the sheets will have the same format.

These are a few tricks that I’ve used before. Let me know what you think.

Code:
    ' Apply header/footer to all tabs
    
    If MsgBox("This will replace the header/footer contents of the entire workbook." & vbCr & "Are you sure you want to continue?", vbYesNoCancel) Then
        
        For Each aSheet In Worksheets
        
            If Right(Trim(aSheet.Name), 1) = ">" Or _
                Right(Trim(aSheet.Name), 3) = "BoP" Or _
                InStr("|TOC|Cover|End|Disclaimer|Letter of presentation|LoP|Glossary|Template|", "|" & aSheet.Name & "|") _
            Then
                
            '...
            
            Else
                'Format the Header and footer in the Template Sheet to look the way you would like it.
                With aSheet.PageSetup
                    .LeftHeader = Worksheets("Template").PageSetup.LeftHeader
                    .CenterHeader = Worksheets("Template").PageSetup.CenterHeader
                    .RightHeader = Worksheets("Template").PageSetup.RightHeader
                    .LeftFooter = Worksheets("Template").PageSetup.LeftFooter
                    .CenterFooter = Worksheets("Template").PageSetup.CenterFooter
                    .RightFooter = Worksheets("Template").PageSetup.RightFooter
                End With

                
            End If
    
    
        Next aSheet
    
    End If
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top