Data Validation Macro

[send2hamilton]

Would love some assitance on a Macro used to retrict users from
entering more than 255 characters in a cell. The following is the
code (a modified John Walkenback code):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim DataOK As Boolean
Dim Msg As String
DataOK = True
For Each cell In Target
If Len(cell) > 255 Then
DataOK = False
cell.Value = Left(cell, 255)
End If
Next cell
If Not DataOK Then
Msg = "We cannot exceed 255 characters! Your text has been
shortened."
MsgBox Msg, vbCritical,
End If
End Sub


This works great until I run other macros that copy a row from another
sheet or inserts new rows, then it locks up on the "If Len(cell)"
line. One example of an additional macro that will not run now is:

Sub AddLumRow()
Application.ScreenUpdating = False
Sheets("CALC").Visible = True
Dim numlum As Integer
numlum = ActiveWorkbook.Worksheets("SCHEDULE").Range("Q4")
Rows(numlum + 5).EntireRow.Select
Selection.Insert Shift:=xlDown,
CopyOrigin:=xlFormatFromRightOrBelow
Sheets("CALC").Range("A4:V4").Copy
ActiveCell.Offset(0, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select
ActiveCell.Select
Application.CutCopyMode = False
Sheets("CALC").Visible = False
End Sub

I have tried validating the range as a string prior to running the
next if statement as follows and it does not catch the cells that are
over 255 characters:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range
Dim DataOK As Boolean
Dim Msg As String
DataOK = True
For Each cell In Target
If WorksheetFunction.IsText(cell) = True Then
If Len(cell) > 255 Then
DataOK = False
cell.Value = Left(cell, 255)
End If
End If
Next cell
If Not DataOK Then
Msg = "We cannot exceed 255 characters! Your text has been
shortened."
MsgBox Msg, vbCritical, Title
End If
End Sub

 

[Dave Peterson]

How about:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim Msg As String
Dim eCtr as long 'error counter
ectr = 0
For Each cell In Target.cells
if cell.hasformula then
'skip it???
else
If Len(cell.value) > 255 Then
ectr = ectr + 1
cell.Value = Left(cell.value, 255)
End if
End If
Next cell
If ectr > 0 Then
Msg = "We cannot exceed 255 characters! " _
& " Your text has been shortened " & format(ectr,"#,##0") _
& " times."
MsgBox Msg, vbCritical
End If
End Sub

 

[send2hamilton]

Thank you. Works like a charm.

Just learning VBA, would you mind explaining to me why the len
function freezes up on seeing a formula? When I try it in excel it
returns the length of the result of the formula. When the eq has an
error it reproduces that error value which I could see freezing the
macro. In this case, the sheet does not have any errors displayed in
the formulas that are present.

Thanks again.

John

 

[Dave Peterson]

It's not the len() function that's causing the trouble.

It's that the cell contains an error.

This'll cause the same problem:

msgbox cell.value

If that cell contains an error.

You could code around it:

For Each cell In Target.cells
if iserror(cell.value) then
'skip it
else
if cell.hasformula then
'skip it???
else
If Len(cell.value) > 255 Then
ectr = ectr + 1
cell.Value = Left(cell.value, 255)
End if
End If
end if
Next cell

 

[send2hamilton]

It's not the len() function that's causing the trouble.

It's that the cell contains an error.

This'll cause the same problem:

msgbox cell.value

If that cell contains an error.

You could code around it:

For Each cell In Target.cells
if iserror(cell.value) then
'skip it
else
if cell.hasformula then
'skip it???
else
If Len(cell.value) > 255 Then
ectr = ectr + 1
cell.Value = Left(cell.value, 255)
End if
End If
end if
Next cell

Thanks for the clarification.

John