Header or Footer

dforgacs

Board Regular
Joined
Jul 16, 2004
Messages
108
Is it possible to:
1. Extract the first, second or third line out of a header or footer with code?
2. Put it in a user form and edit that line and then put it back?

I can extract the Left, Center or Right, Header or Footer but only as a whole. I'm trying to split the lines up for editing in an ISO tool. Help!

dforgacs
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

dforgacs

Board Regular
Joined
Jul 16, 2004
Messages
108
I've searched the archives for threads and all the book I have, and haven't found anything! No one has replied?
Isn't there someone who knows if this is possible?
I would appreciate any comments or direction!
Help!
dforgacs
 

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
I had a go at setting up a Userform for this task using ComboBoxes but it gave too many opportunities for things to go wrong. I seem to have come back to a method that seems to have stood me in good stead for various applications - mainly because it is so easy to read to, edit, and write from a worksheet without too many possibilities for error.

The following consists of 2 macros. One to extract the header/footer data and another to write it back after editing. It also allows for additional lines.
Code:
'==============================================================================
'- 2 MACROS TO EDIT WORKSHEET HEADER & FOOTER
'- 1. 'READ_HEADER_FOOTER'  reads from the active sheet (makes a new worksheet)
'- 2. 'WRITE_HEADER_FOOTER' writes amended data back to the original
'- Handles multi lines.
'- Brian Baulsom  July 2007 using Excel 2000
'==============================================================================
Option Explicit
Dim WS As Worksheet
Dim ToRow As Long
Dim ToCol As Integer
Dim OriginalSheetName As String
Dim HeadFootStrings(6)
Dim s, c, c1, c2, L

'==============================================================================
'- 1. READ MACRO -
'- Run macro from the sheet to be checked - *EITHER* makes a new sheet
'- *OR* updates an existing "Read" sheet (looks for $A$3 = "Left Header")
'==============================================================================
Sub READ_HEADER_FOOTER()
    Dim LastCell As String
    Dim LastRow As Long
    Dim LastCol As Integer
    Dim MyStr As String
    '-------------------------------------------------------------------
    '- check active sheet for new or existing data
    If ActiveSheet.Range("A3").Value = "Left Header" Then
        '- UPDATE EXISTING SHEET
        OriginalSheetName = ActiveSheet.Range("A1").Value
        '------------------------------
        LastRow = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, _
        SearchOrder:=xlByRows).Row
        '------------------------------
        LastCol = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, _
        SearchOrder:=xlByColumns).Column
        '------------------------------
        LastCell = ActiveSheet.Cells(LastRow, LastCol).Address
        Range("A4:" & LastCell).ClearContents
    Else
    '-------------------------------------------------------------------
        '- MAKE NEW WORKSHEET
        OriginalSheetName = ActiveSheet.Name
        Set WS = Worksheets.Add
        WS.Name = "HF - " & OriginalSheetName
        '-----------------------------------------------------------------
        '- original sheet name
        With WS.Range("A1")
            .Value = OriginalSheetName
            .Font.Bold = True
            .Font.Size = 14
            .RowHeight = 30
        End With
        '-----------------------------------------------------------------
        '- column headers
        With WS.Range("A3:F3")
            .ColumnWidth = 28
            .Value = _
            Array("Left Header", "Centre Header", "Right Header", "Left Footer", "Centre Footer", "Right Footer")
            .Interior.ColorIndex = 34
            .Font.Bold = True
        End With
        '------------------------------------------------------------------
        '- add WRITE button
        ActiveSheet.Buttons.Add(200, 5, 150, 25).Select
        Selection.OnAction = "WRITE_HEADER_FOOTER"
        With Selection.Characters
            .Text = "WRITE HEADERS & FOOTERS"
            .Font.Size = 10
        End With
    End If
    '================================================================
    '- GET HEADER & FOOTER DATA
    '================================================================
    With Worksheets(OriginalSheetName).PageSetup
        HeadFootStrings(1) = .LeftHeader
        HeadFootStrings(2) = .CenterHeader
        HeadFootStrings(3) = .RightHeader
        HeadFootStrings(4) = .LeftFooter
        HeadFootStrings(5) = .CenterFooter
        HeadFootStrings(6) = .RightFooter
    End With
    '-------------------------------------------------------------
    '- parse strings
    ToCol = 1
    For s = 1 To 6
        ToRow = 4
        MyStr = HeadFootStrings(s)
        c1 = 1
        L = Len(MyStr)
        If L = 0 Then Exit Sub
        '--------------------------------------------------------------
        '- parse string
        For c = 1 To L
            '- check for end of line character chr(10)
            If Asc(Mid(MyStr, c, 1)) = 10 Then
                WS.Cells(ToRow, ToCol).Value = Mid(MyStr, c1, c - c1)
                ToRow = ToRow + 1
                c1 = c + 1
            End If
        Next
        If c1 < L Then
            WS.Cells(ToRow, ToCol).Value = Mid(MyStr, c1, c - c1)
        End If
        '-------------------------------------------------------------
        '- next column
        ToCol = ToCol + 1
    Next
    '-----------------------------------------------------------------
    MsgBox ("Done")
End Sub
'===========END OF READ ROUTINE ======================================

'======================================================================
'- 2. WRITE MACRO
'- Writes amended data from the "Read" sheet to the original worksheet
'======================================================================
Sub WRITE_HEADER_FOOTER()
    Dim LastRow, MyStr As String
    '-----------------------------------------------------------------
    '- sheet data to HeadFootStrings
    Set WS = ActiveSheet
    For ToCol = 1 To 6
        LastRow = WS.Cells(65536, ToCol).End(xlUp).Row
        MyStr = ""
            For ToRow = 4 To LastRow
                MyStr = MyStr & WS.Cells(ToRow, ToCol).Value
                If ToRow < LastRow Then MyStr = MyStr & Chr(10)
            Next
        HeadFootStrings(ToCol) = MyStr
    Next
    '----------------------------------------------------------------
    '- update original worksheet
    OriginalSheetName = WS.Range("A1").Value
    With Worksheets(OriginalSheetName).PageSetup
        .LeftHeader = HeadFootStrings(1)
        .CenterHeader = HeadFootStrings(2)
        .RightHeader = HeadFootStrings(3)
        .LeftFooter = HeadFootStrings(4)
        .CenterFooter = HeadFootStrings(5)
        .RightFooter = HeadFootStrings(6)
    End With
    '----------------------------------------------------------------
    MsgBox ("Done")
End Sub
'============= END OF WRITE ROUTINE ====================================
 

Forum statistics

Threads
1,181,405
Messages
5,929,756
Members
436,687
Latest member
Glass of Gin

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
Top