Clever code sought re/ Excel ##### printing 2

[larryww]

(Cross-posted to Microsoft: Office 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 me 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

 

[RobBroekhuis]

The following condition is helpful in writing the code:

left(c.Text,1)="#" and isnumeric(c)

If this evaluates to true, the format cannot be displayed in the cell.
Rob

 

[larryww]

Rob - you genius - that's it! Go put it in the Microsoft: Office Forum thread too, so I can star you there too!

I made a minor modification, but give you all the credit.
?left(activecell.Text,1)=&quot;#&quot; and (isnumeric(c) or isdate(c))

Man, you've redeemed my plummeting faith in the forum! Way to go.

 

[SkipVought]

RobBroekhuis ,

WAY 2 GO!

I was looking for that -- ActiveCell.Text!

That's great! ==> A STAR! Skip,
metzgsk@voughtaircraft.com

 

[RobBroekhuis]

Gee, thanks guys

 

[larryww]

One further worthwhile tweak - prevent hidden column analysis:
If Left(c.Text, 1) = &quot;#&quot; And c.ColumnWidth > 0 And (IsNumeric(c) Or IsDate(c)) Then

So this could essentially be substituted for
If IsError(c) Then

in the FindErrorsCurrentSheet() routine above, to give a FindSTARSCurrentSheet() or whatever.

Great stuff. Again, way to go.

 

[larryww]

Just as soon as I hit submit, I realized that I should have mentioned to delete the lines with bIGNORE_NOT_APPLIC, if the FindErrorsCurrentSheet code is emulated for FindSTARSCurrentSheet.