Determining Header Section Overlap in a Macro

Brian uses a macro to create a page header, utilizing all sections of the header. In the sections he sets the font size, but sometimes the desired size is too large based on the information he needs to put in the section. He wonders if there is a way, in a macro, to determine if the header sections will overlap based on the text and the font size. If so, that would allow him to adjust font size within the macro to avoid any overlapping.

There is a whole lot of stuff going on when it comes to the headers (and footers) in your worksheets. I think that the best way to demonstrate this is to consider a macro that is not terribly short:

Sub CheckHeaderOverlap()
    Dim ps As PageSetup
    Dim pgWidth As Double
    Dim leftHdr As String
    Dim centerHdr As String
    Dim rightHdr As String
    Dim leftWidth As Double
    Dim centerWidth As Double
    Dim rightWidth As Double
    Dim centerStart As Double
    Dim centerEnd As Double
    Dim rightStart As Double
    Dim sProbs As String
    Dim sMsg As String

    ' Assumed font size. By default, Excel uses an 11-pt
    ' font. If you want a different font size assumed in
    ' the calculations,specify it here.
    Const fontSize As Double = 11

    ' Factor for average character width relative to height.
    ' Change as needed. This cannot be computed by the macro
    ' because different characters can be different widths,
    ' thus the need to figure out an "average" width. If the
    ' font is a narrow font, then the width can be as low as
    ' 0.43; if it is a wide font, then it can as high as 0.65.
    Const widthFactor As Double = 0.54

    Set ps = ActiveSheet.PageSetup

    ' Determine width based on paper size
    Select Case ps.PaperSize
        Case xlPaperA4
            pgWidth = 8.27
        Case xlPaperLetter
            pgWidth = 8.5
        Case xlPaperLegal
            pgWidth = 8.5
        Case xlPaperA3
            pgWidth = 11.69
        Case xlPaperA5
            pgWidth = 5.83
        Case Else
            pgWidth = 8.5
    End Select
    pgWidth = Application.InchesToPoints(pgWidth)

    ' From this point, all widths are handled in points
    pgWidth = pgWidth - ps.LeftMargin - ps.RightMargin

    ' Create clean header text
    leftHdr = StripHeaderFormatting(ps.LeftHeader)
    centerHdr = StripHeaderFormatting(ps.CenterHeader)
    rightHdr = StripHeaderFormatting(ps.RightHeader)

    ' Approximate widths
    leftWidth = Len(leftHdr) * fontSize * widthFactor
    centerWidth = Len(centerHdr) * fontSize * widthFactor
    rightWidth = Len(rightHdr) * fontSize * widthFactor

    ' Compute start/end positions for center section
    centerStart = (pgWidth - centerWidth) / 2
    centerEnd = centerStart + centerWidth
    rightStart = pgWidth - rightWidth

    ' Check for possible overlaps
    If leftWidth > centerStart Then
        sProbs = sProbs & "Left header may overlap center header." & vbCr
    End If
    If leftWidth > rightStart Then
        sProbs = sProbs & "Left header may overlap right header." & vbCr
    End If
    If centerEnd > rightStart Then
        sProbs = sProbs & "Center header may overlap right header." & vbCr
    End If
    If sProbs = "" Then
        sProbs = "No overlap problems detected"
    Else
        sProbs = "Potential overlap issues:" & vbCr & sProbs
    End If

    ' Create message
    sMsg = "Page stats:" & vbCr
    sMsg = sMsg & "Printable width: " & Format(pgWidth, "0.0") & " pts" & vbCr
    sMsg = sMsg & "Left width: " & Format(leftWidth, "0.0") & " pts" & vbCr
    sMsg = sMsg & "Center width: " & Format(centerWidth, "0.0") & " pts" & vbCr
    sMsg = sMsg & "Right width: " & Format(rightWidth, "0.0") & " pts" & vbCr & vbCr
    sMsg = sMsg & sProbs
    MsgBox sMsg, vbInformation
End Sub

Private Function StripHeaderFormatting(ByVal s As String) As String
    ' Remove Excel header formatting codes
    Dim sTemp As String
    Dim i As Long

    sTemp = ""
    i = 1
    Do While i <= Len(s)
        If Mid$(s, i, 1) = "&" Then
            If i + 1 <= Len(s) And Mid$(s, i + 1, 1) = """" Then
                i = i + 2
                Do While i <= Len(s) And Mid$(s, i, 1) <> """"
                    i = i + 1
                Loop
                i = i + 1
            Else
                i = i + 2
            End If
        Else
            sTemp = sTemp & Mid(s, i, 1)
            i = i + 1
        End If
    Loop
    StripHeaderFormatting = sTemp
End Function

At the lowest level, you need to determine how much space is available in each section of the header. You do this figuring out the paper size being used and subtracting the left and right margin from that width. Then, each section of the header (left, center, and right) has a width of a third of that adjusted width.

In this macro, paper size is determined by looking at the .PaperSize property of the PageSetup object. The macro uses a simplistic Select Case structure to set the page width, in inches, based on the paper size. If you need to adjust this structure for other paper sizes, you can find the usable enumerations here:

https://learn.microsoft.com/en-us/office/vba/api/excel.xlpapersize

The macro then calculates the space used by the text in each header section. It uses the StripHeaderFormatting function to remove formatting codes, leaving just the text. Then, the font size (fontSize) and average character width ratio (widthFactor) are used to calculate the width of the text in each section, in points.

Given the width, in points, of the text in each section, it is easy to figure out if there is any potential overlap. The results of the analysis are reported in a message box; nothing within the header sections is actually changed. It is assumed that you would go back and change the text in each header section and re-run the macro to see if you get different results.

Notice that there are two constants used in the macro, fontSize and widthFactor. These constants need a bit of detailed explanation. The fontSize constant is straightforward—it is the size, in points, of the font you are using. Font size, however, denotes the height of a font, not the width of the characters in the font. Since most fonts use variable-width letters, it is not an easy thing to convert from a particular font height to a font's width. It can be determined if one accesses the internals of an actual font, but such a task is beyond the capability of a macro such as this one. Even if the macro could be enhanced to access the font file internals, Excel can adjust those internal settings to adapt the font to the display and printer being used.

This complexity is why the widthFactor is used. It provides an educated guesstimate as to the average width of a character in a font relative to the height of the font. In most fonts, this factor ranges from 0.43 for narrow fonts to 0.65 for wide fonts. You will want to adjust this factor based on your actual font being used.

The easiest way to do this is to print a sentence in your left header section such as "The quick brown fox jumps over the lazy dog," without a trailing period or comma. (Make sure the center and right header sections are empty before you print.) Measure how many inches are used by the sentence on the printout, then multiply that by 72. This gives you the sentence length in points. Divide that number by 43 (the number of letters in the sentence) and you then have the number of points required for an average letter width in your font. Divide this number by the font height, and you end up with the widthFactor—the width of an average character relative to the height of the font.

For instance, on my system I did the above exercise, and the sentence required 2.875 inches, or 207 points. Dividing that by 43 resulted in an average character width of 4.814 points. Dividing that by the font height (11 points), resulted in a widthFactor of 0.44. My system uses an 11-pt Aptos Narrow font as a default for the heading, but I have a different system that uses a 16-pt Calibri. (On that other system, the print of the sentence took 4 inches—quite a difference!) This variance among systems is why you need to go through the steps of figuring out what is used on your system, by default, and calculating the widthFactor based on those defaults.

Hopefully, the technique contained within this macro will help Brian figure out the best way to adapt the concepts to his own macro.

ExcelTips is your source for cost-effective Microsoft Excel training. This tip (13959) applies to Microsoft Excel 2007, 2010, 2013, 2016, 2019, 2021, 2024, and Excel in Microsoft 365.