macro to run on single worksheet...not all

B

bluepenink

Well-known Member
Joined
Dec 21, 2010
Messages
585
hello

below is a code i use to format my workbooks..however i was wondering if someone can help me make it apply towards a single worksheet...currently if i run the macro, it applies this on all worksheets in the workbook.

thx u

Code: 
Sub marginsheader()
' creates left, right, top and bottom margins; header and footer; blue border title and printing 
    Dim objSheet As Object
 
    Application.ScreenUpdating = False
    For Each objSheet In ActiveWorkbook.Sheets
 
        With objSheet
            With .PageSetup
                .RightHeader = "&""Arial,Regular""&8DRAFT"
                .LeftFooter = "&""Arial,Regular""&8&F"
                .CenterFooter = "&""Arial,Regular""&8Confidential"
                .RightFooter = "&""Arial,Regular""&8Page: &P of &N"
                .LeftMargin = Application.CentimetersToPoints(0.25)
                .RightMargin = Application.CentimetersToPoints(0.25)
                .TopMargin = Application.InchesToPoints(0.37)
                .BottomMargin = Application.InchesToPoints(0.41)
                .HeaderMargin = Application.InchesToPoints(0.2)
                .FooterMargin = Application.InchesToPoints(0.23)
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = False
            End With
 
            If TypeOf objSheet Is Worksheet Then
                .Columns("A:B").ColumnWidth = 0.75
                .Columns("P:Q").ColumnWidth = 0.75
                .Rows("1:2").RowHeight = 5.25
 
                'change range below for desired blue fill for title
                 Range("C3:O3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10027008
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Font
 
    End With
    Selection.Font.Bold = True
 
            End If
        End With
 
    Next objSheet
 
    Application.ScreenUpdating = True
End Sub
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
try this
Code: 
Sub marginsheader()
' creates left, right, top and bottom margins; header and footer; blue border title and printing
    Dim objSheet As Object
 
    Application.ScreenUpdating = False
    
objSheet = Activeworksheet
 
        With objSheet
            With .PageSetup
                .RightHeader = "&""Arial,Regular""&8DRAFT"
                .LeftFooter = "&""Arial,Regular""&8&F"
                .CenterFooter = "&""Arial,Regular""&8Confidential"
                .RightFooter = "&""Arial,Regular""&8Page: &P of &N"
                .LeftMargin = Application.CentimetersToPoints(0.25)
                .RightMargin = Application.CentimetersToPoints(0.25)
                .TopMargin = Application.InchesToPoints(0.37)
                .BottomMargin = Application.InchesToPoints(0.41)
                .HeaderMargin = Application.InchesToPoints(0.2)
                .FooterMargin = Application.InchesToPoints(0.23)
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = False
            End With
 
            If TypeOf objSheet Is Worksheet Then
                .Columns("A:B").ColumnWidth = 0.75
                .Columns("P:Q").ColumnWidth = 0.75
                .Rows("1:2").RowHeight = 5.25
 
                'change range below for desired blue fill for title
                 Range("C3:O3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10027008
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Font
 
    End With
    Selection.Font.Bold = True
 
            End If
        End With
 
    
 
    Application.ScreenUpdating = True
End Sub

hth,
Shope
 
Upvote 0
I have included an if function to your macro to run on active sheet only (before running this macro select the sheet where you want to apply formatting then run this macro)
Active sheet is the sheet visble to you.
example if you have seleted sheet2 then active sheet is sheet2

Dim objSheet As Object

'Application.ScreenUpdating = False
For Each objSheet In ActiveWorkbook.Sheets
If ActiveSheet.Name = objSheet.Name Then
With objSheet
With .PageSetup
.RightHeader = "&""Arial,Regular""&8DRAFT"
.LeftFooter = "&""Arial,Regular""&8&F"
.CenterFooter = "&""Arial,Regular""&8Confidential"
.RightFooter = "&""Arial,Regular""&8Page: &P of &N"
.LeftMargin = Application.CentimetersToPoints(0.25)
.RightMargin = Application.CentimetersToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.37)
.BottomMargin = Application.InchesToPoints(0.41)
.HeaderMargin = Application.InchesToPoints(0.2)
.FooterMargin = Application.InchesToPoints(0.23)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With

If TypeOf objSheet Is Worksheet Then
.Columns("A:B").ColumnWidth = 0.75
.Columns("P:Q").ColumnWidth = 0.75
.Rows("1:2").RowHeight = 5.25

'change range below for desired blue fill for title
Range("C3:O3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10027008
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Font

End With
Selection.Font.Bold = True

End If
End With

Else
End If

Next objSheet

Application.ScreenUpdating = True
End Sub
 
Upvote 0
If you just want it applied to the active sheet,

Code: 
Sub MarginsHeader()
    Application.ScreenUpdating = False
 
    With ActiveSheet
        With .PageSetup
            .RightHeader = "&""Arial,Regular""&8DRAFT"
            .LeftFooter = "&""Arial,Regular""&8&F"
            .CenterFooter = "&""Arial,Regular""&8Confidential"
            .RightFooter = "&""Arial,Regular""&8Page: &P of &N"
            .LeftMargin = 72 * 0.25
            .RightMargin = 72 * 0.25
            .TopMargin = 72 * 0.37
            .BottomMargin = 72 * 0.41
            .HeaderMargin = 72 * 0.2
            .FooterMargin = 72 * 0.23
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With
 
        If TypeOf ActiveSheet Is Worksheet Then
            .Columns("A:B").ColumnWidth = 0.75
            .Columns("P:Q").ColumnWidth = 0.75
            .Rows("1:2").RowHeight = 5.25
 
            With Range("C3:O3")
                With .Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 10027008
                End With
 
                .BorderAround LineStyle:=xlContinuous, _
                              ColorIndex:=0, _
                              Weight:=xlThin
                .Font.Bold = True
            End With
        End If
    End With
 
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hello guys

thxs for the awesome response.

quick question....

im not to pro at this at all...but this be added:

a popup that ask what sheets to format or apply this macro to?

also, can the user have the ability to select per their need on these:

.Columns("P:Q").ColumnWidth = 0.75
....&....
With Range("C3:O3")

i.e. change range from P:Q to Z:AA
and
range C3:O3 to be set by user?

i.e. a quick forum? appreciate it.
thx u so much.
 
Upvote 0
SatishKumar.Dx said:
I have included an if function to your macro to run on active sheet only (before running this macro select the sheet where you want to apply formatting then run this macro)
Active sheet is the sheet visble to you.
example if you have seleted sheet2 then active sheet is sheet2

Dim objSheet As Object

'Application.ScreenUpdating = False
For Each objSheet In ActiveWorkbook.Sheets
If ActiveSheet.Name = objSheet.Name Then
With objSheet
With .PageSetup
.RightHeader = "&""Arial,Regular""&8DRAFT"
.LeftFooter = "&""Arial,Regular""&8&F"
.CenterFooter = "&""Arial,Regular""&8Confidential"
.RightFooter = "&""Arial,Regular""&8Page: &P of &N"
.LeftMargin = Application.CentimetersToPoints(0.25)
.RightMargin = Application.CentimetersToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.37)
.BottomMargin = Application.InchesToPoints(0.41)
.HeaderMargin = Application.InchesToPoints(0.2)
.FooterMargin = Application.InchesToPoints(0.23)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With

If TypeOf objSheet Is Worksheet Then
.Columns("A:B").ColumnWidth = 0.75
.Columns("P:Q").ColumnWidth = 0.75
.Rows("1:2").RowHeight = 5.25

'change range below for desired blue fill for title
Range("C3:O3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10027008
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Font

End With
Selection.Font.Bold = True

End If
End With

Else
End If

Next objSheet

Application.ScreenUpdating = True
End Sub
Click to expand...

hey bud

i tried selecting multiple sheets and running this code, but it didnt do the margins for some odd reason or the header/footer etc on the second sheet i selected.
strange:S
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
591
RoryA
RoryA
P
  • Question Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
378
6StringJazzer
6StringJazzer
J
  • Question Question
Issue with Macros and renaming files
Replies
6
Views
1K
kevin9999
K
J
  • Question Question
VBA Code to Add Rows is slowing down
Replies
5
Views
998
JayB0730
J
S
  • Question Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
542
sspatriots
S

Forum statistics

Threads
1,224,517
Messages
6,179,239
Members
452,898
Latest member
Capolavoro009

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top