VBA Headers & Footers - VERY slow

Thanks Thanks:  0
Likes Likes:  0
Results 1 to 4 of 4

Thread: VBA Headers & Footers - VERY slow

  1. #1
    MrExcel MVP Richie(UK)'s Avatar
    Join Date
    May 2002
    Location
    UK
    Posts
    3,329
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA Headers & Footers - VERY slow

     
    Hi all,

    I have some VBA code (see below) to set-up custom headers and footers based upon worksheet values. The headers and footers are to be applied to each of the (4) worksheets in the workbook.

    The code works but is VERY slow. Anybody got any tips on speeding it up? (And I don't mean the 'buy a faster computer' type of tip )
    Code:
    Sub CustomHeaderFooter()
    Dim ws As Worksheet
    Dim strLH As String, strCH As String, strRH As String
    Dim strLF As String, strCF As String, strRF As String
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    With Sheet1
        strLH = .Range("C43").Value
        strCH = .Range("C44").Value
        strRH = .Range("C45").Value
        strLF = .Range("C46").Value
        strCF = .Range("C47").Value
        strRF = .Range("C48").Value
    End With
    'get values from Sheet1 (User Input)
    
    For Each ws In ThisWorkbook.Worksheets
        With ws.PageSetup
            .LeftHeader = strLH
            .CenterHeader = strCH
            .RightHeader = strRH
            .LeftFooter = strLF
            .CenterFooter = strCF
            .RightFooter = strRF
        End With
    Next
    'pass values to PageSetup
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
    End Sub
    Richie

  2. #2
    Board Regular
    Join Date
    Apr 2002
    Posts
    2,314
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Richie,

    Try this, I got it from this board...



    Sub margins()
    'decrease margins, taken from;
    ' http://groups.google.com.au/groups?q...ron.net&rnum=1

    head = ""
    foot = ""
    pLeft = 0.3
    pRight = 0.3
    Top = 0.4
    bot = 0.36
    head_margin = 0.22
    foot_margin = 0.17
    hdng = False
    grid = False
    notes = False
    quality = ""
    h_cntr = False
    v_cntr = False
    orient = 1
    Draft = False
    paper_size = 1
    pg_num = ""
    pg_order = 1
    bw_cells = False
    pscale = True

    pSetUp = "PAGE.SETUP(" & head & "," & foot & "," & pLeft & "," & pRight & ","
    pSetUp = pSetUp & Top & "," & bot & "," & hdng & "," & grid & "," & h_cntr & ","
    pSetUp = pSetUp & v_cntr & "," & orient & "," & paper_size & "," & pscale & ","
    pSetUp = pSetUp & pg_num & "," & pg_order & "," & bw_cells & "," & quality & ","
    pSetUp = pSetUp & head_margin & "," & foot_margin & "," & notes & "," & Draft & ")"

    Application.ExecuteExcel4Macro pSetUp
    With ActiveSheet.PageSetup
    .Zoom = 100
    End With
    End Sub

  3. #3
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    The XL4 code simulates this code...try this as well
    Although in some tests I have done with similar the XL4 macro
    is slightly faster.....

    Code:
    Sub CustomHeaderFooter()
    St = Timer
    Dim ws As Worksheet
    Dim strLH As String, strCH As String, strRH As String
    Dim strLF As String, strCF As String, strRF As String
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    With Sheet1
        strLH = "&L" & .Range("C43").Value
        strCH = "&C" & .Range("C44").Value
        strRH = "&R" & .Range("C45").Value
        strLF = "&L" & .Range("C46").Value
        strCF = "&C" & .Range("C47").Value
        strRF = "&R" & .Range("C48").Value
    End With
    
    'get values from Sheet1 (User Input)
    
    For Each ws In ThisWorkbook.Worksheets
        ws.Activate
        ws.DisplayPageBreaks = False
        Application.SendKeys "{ENTER}", False
        Application.Dialogs(xlDialogPageSetup).Show _
            Arg1:=strLH & strCH & strRH, _
            Arg2:=strLF & strCF & strRF
    Next
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
    Sheet1.Activate
    ActiveCell = Timer - St
    End Sub
    Kind Regards,
    Ivan F Moala From the City of Sails

  4. #4
    MrExcel MVP Richie(UK)'s Avatar
    Join Date
    May 2002
    Location
    UK
    Posts
    3,329
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    Thank you both very much for your help on this. Both methods offer a substantial improvement over the original . In case you're curious the times for each were:

    Original:---- 13.5 secs (I know, its not THAT long - but it seems like it!)
    E4Macro:----- 0.8 secs
    IFM:---------- 2.9 secs

    Thanks again :D
    Richie

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com