ERLANDSEN DATA CONSULTING Excel & VBA Tips   Informasjon på norsk / Information in Norwegian

These pages are no longer updated and are only available for archive purposes.

Click here to visit the pages with updated information.

Return how many characters that will fit in the column width

As long as you are using the default/normal font this problem has a simple solution:
ActiveCell.ColumnWidth will return a numbers that represents the average character count that will fit inside the column width, assuming you are using the font defined in the Normal style.

If you are using a different font you can use the function below to return how many characters that on average will fit within a column using your own font and style:

Function GetColumnCharsCount(rngInputCell As Range, strFont As String, intSize As Integer, _
    blnBold As Boolean, blnItalic As Boolean) As Double
' returns the average count of characters that can be displayed within rngInputCell 
' for a given font, size and style
' rngInputCell is supposed to be a single cell only, 
' it can not be a cell in the last column in a worksheet
' example use:
' dblResult = GetColumnCharsCount(ActiveCell, "Arial", 14, True, False)
' dblResult = GetColumnCharsCount(Range("A1"), "Arial Narrow", 8, False, False)
Dim s As Style, asu As Boolean, c As Long, dblPixels(0 To 2) As Double
Dim strFont1 As String, intSize1 As Integer, blnBold1 As Boolean, blnItalic1 As Boolean
Dim dblColWidth As Double
    If rngInputCell Is Nothing Then Exit Function
    On Error Resume Next
    Set s = ActiveWorkbook.Styles("Normal")
    On Error GoTo 0
    If s Is Nothing Then Exit Function
    asu = Application.ScreenUpdating
    If asu Then
        Application.ScreenUpdating = False
    End If
    With s.Font
        ' store original settings for the Normal style
        strFont1 = .Name
        intSize1 = .Size
        blnBold1 = .Bold
        blnItalic1 = .Italic
        dblColWidth = rngInputCell.ColumnWidth
        ' get the average characters/pixel
        dblPixels(1) = dblColWidth / (rngInputCell.Offset(0, 1).Left - rngInputCell.Left)
        ' change to temporary settings for the Normal style
        .Name = strFont
        .Size = intSize
        .Bold = blnBold
        .Italic = blnItalic
        ' get the average characters/pixel
        dblPixels(2) = dblColWidth / (rngInputCell.Offset(0, 1).Left - rngInputCell.Left)
        ' restore original settings for the Normal style
        .Name = strFont1
        .Size = intSize1
        .Bold = blnBold1
        .Italic = blnItalic1
    End With
    If asu Then
        Application.ScreenUpdating = True
    End If
    ' calculate result
    GetColumnCharsCount = dblColWidth * dblPixels(2) / dblPixels(1)
End Function

Sub TestGetColumnCharsCount()
Dim dlbResult As Double
    dlbResult = GetColumnCharsCount(ActiveCell, "Verdana", 14, True, False)
    MsgBox "The active cell can on average display " & Format(dlbResult, "0.0") & _
        " characters in Verdana 14 point bold!", vbInformation
End Sub


Document last updated 2006-01-27 11:10:57      Printerfriendly version


Erlandsen Data Consulting   
Excel & VBA Tips   Copyright ©1999-2024    Ole P. Erlandsen   All rights reserved
E-mail Contact Address