Clever coder sought re/ Excel ##### printing

[larryww]

(Cross-posted to VBA Visual Basic for Applications (Microsoft) Forum, which I believe is a distinct audience from this)

I'm looking for a C.Y.A. routine to alert me when I have Excel columns that are too narrow, causing ##### to print. I'm hoping that someone has an ingenious solution, though this might require hooking O/S internals; I'm looking for a V.B.A. solution, not C code for this.

For an example of the process, help yourself to this *deeply* invaluable code below which I use to "proofread" spreadsheets before release. You will probably want to think about which way to set the 2 Booleans. (I manage them via Form input, stripped from the code below.)

The code below has saved my butt countless times. If you have a ##### solution or other useful "C.Y.A." techniques, feel free to holler in.

Option Explicit
Function FindErrorsCurrentSheet() As Boolean
'Search every cell in this worksheet; stop code on first hit of #REF or any other error
'Preserves selection if no errors, but loses it if it finds errors outside current selection
Dim c As Range, bIGNORE_NOT_APPLIC As Boolean, CARR_RET As String * 2 '(carriage return)

CARR_RET = Chr(10) ' & Chr(13) unnecessary
FindErrorsCurrentSheet = True
'bIGNORE_NOT_APPLIC=true 'toggle this sucker here or immediate win. when too many Stops hamper you
For Each c In ActiveSheet.UsedRange.Cells
If IsError(c) Then
'c.Interior.ColorIndex = 7 'highlight all matches in purple
c.Activate
If (Not bIGNORE_NOT_APPLIC) Or (bIGNORE_NOT_APPLIC And (c.Text <> &quot;#N/A&quot) Then
'comment next if bothersome - pauses execution
If vbCancel = MsgBox(&quot;Found - hit enter or click OK to&quot; & CARR_RET & &quot;continue to next; else escape key&quot; _
, vbOKCancel, &quot;Error found&quot Then FindErrorsCurrentSheet = False: Exit Function
End If
End If
Next
End Function
Sub FindErrorsAllSheets()
'Search all or rest of worksheets in workbook; stop code on first hit of #REF or any other error
'Preserves selection on sheets without errors, but loses it on those that have errors outside current selection
'Checks entire sheets regardless of selection; active sheet loses focus
Dim wksht As Worksheet
Dim bDoAllSheets As Boolean 'TRUE to start from sheet 1, else from current sheet

If bDoAllSheets Then
For Each wksht In Sheets
wksht.Activate
If Not FindErrorsCurrentSheet Then Exit Sub
Next wksht
Else
While True
If Not FindErrorsCurrentSheet Then Exit Sub
On Error GoTo err1FindErrorsAllSheets
ActiveSheet.Next.Select
On Error GoTo 0
Wend
End If
Set wksht = Nothing
Exit Sub
err1FindErrorsAllSheets: 'don't leave mad - just leave
End Sub

 

[SkipVought]

Larry,

Why not use...

ActiveSheet.UsedRange.Columns.AutoFit

Skip,
metzgsk@voughtaircraft.com

 

[SkipVought]

AND...

if you have a threshhold width as a minimum...

Sub SetColumnsWidths()
    Dim Col As Range
    Const COL_MIN_WID = 8
    With ActiveSheet.UsedRange
        .Columns.AutoFit
        For Each Col In .Columns
            With Col
                If .ColumnWidth < COL_MIN_WID Then
                    .ColumnWidth = COL_MIN_WID
                End If
            End With
        Next
    End With
End Sub

Skip,
metzgsk@voughtaircraft.com

 

[larryww]

I suppose that there are people out there that don't know about autofit, and you probably did them a service. That is a nice job of showing how to fit it in VBA.

However...autofit is not the clever solution I seek for several reasons. For one thing it is not 100% reliable - it may be over 99%, but I have seen it fail (perhaps due to a WYSIWYG or printer driver weakness). But mostly, using autofit over large ranges (my main target here is obviously massive worksheets/workbooks) will overcompensate for text, which harmlessly spills over into adjacent unused cells (or, yes, might truncate). A sentence typed in cell A501 will cause autofit to be, say, 100 times too large for the integers in the 500 cells above it.

Maybe that's the best we'll find, yet I'm hoping to just target NUMBERS - you know, the ones that go #####.

 

[dsi]

You can simply expand Skip's method. This just adds 0.2 to the AutoFit setting for each column.

Sub SetColumnsWidths()
    Dim Col As Range
    Dim vWidth As Variant
    
    With ActiveSheet.UsedRange
        .Columns.AutoFit
        For Each Col In .Columns
            With Col
                vWidth = .ColumnWidth + 0.2
                .ColumnWidth = vWidth
            End With
        Next
    End With
End Sub

 

[SkipVought]

Hi,

Here's the cleverist &quot;clever coder&quot; code I could conjer...

Function ResizeColumnsToFitNumbers() As Boolean
'finds max numeric values in eac col
'and uses that cell to column auto fit
    Dim c As Range, NumVal
    For Each c In ActiveSheet.UsedRange.Columns
        NumVal = Application.WorksheetFunction.Max(c)
        If NumVal > 0 Then
           Cells(Application.WorksheetFunction.Match(NumVal, c, 0), c.Column).Columns.AutoFit
        'put any minimum column width override here
        
        End If
    Next
End Function

Hope this fills the bill Skip,
metzgsk@voughtaircraft.com

 

[larryww]

If you want a great solution, it came from RobBroekhuis in thread707-248807 - stars out the wazoo.