limit number of characters in cell

[sue@solotel]

Hi
Is there a way to limit the number of characters that can be entered into a
cell ?
I am setting up a database for export to another programme that can only
take a descriptor line of 30 characters

 

[AltaEgo]

You can do this with VBA.

Right-click the tab of the relevant sheet.
Click View Code
Paste the following:

A1:C9 in the code restricts it to a specific range. If you need this
restriction, amend to the appropriate values.

Private Sub Worksheet_Change(ByVal Target As Range)
Const rEval = "A1:C9"

Set isect = Application.Intersect(Range(rEval), Target)
If Not isect Is Nothing Then
If Len(Target.Value) > 30 Then
Target.Value = Left(Target.Value, 30)
MsgBox ("Value must not exceed 30." & vbCrLf & _
"Entered data trimmed.")
End If

End If
End Sub

If you do not need the restriction, use this:

Private Sub Worksheet_Change(ByVal Target As Range)

If Len(Target.Value) > 30 Then
Target.Value = Left(Target.Value, 30)
MsgBox ("Value must not exceed 30." & vbCrLf & _
"Entered data trimmed.")
End If

End Sub

 

[sue@solotel]

Excellent - thankyou very much

You can do this with VBA.

Right-click the tab of the relevant sheet.
Click View Code
Paste the following:

A1:C9 in the code restricts it to a specific range. If you need this
restriction, amend to the appropriate values.

Private Sub Worksheet_Change(ByVal Target As Range)
Const rEval = "A1:C9"

Set isect = Application.Intersect(Range(rEval), Target)
If Not isect Is Nothing Then
If Len(Target.Value) > 30 Then
Target.Value = Left(Target.Value, 30)
MsgBox ("Value must not exceed 30." & vbCrLf & _
"Entered data trimmed.")
End If

End If
End Sub

If you do not need the restriction, use this:

Private Sub Worksheet_Change(ByVal Target As Range)

If Len(Target.Value) > 30 Then
Target.Value = Left(Target.Value, 30)
MsgBox ("Value must not exceed 30." & vbCrLf & _
"Entered data trimmed.")
End If

End Sub

 

[Per Jessen]

Hi

Another way without VBA:

Select the cell(s), goto Data > Validation > Allow: Text Lenght >
Data: Less than > Maximum 30 > Select "Error Alert" tab to create you
own error message if you want to else just > OK

Hopes this helps.
....
Per

 

[AltaEgo]

Forgot to trap errors to work around multiple cells. Also, you do understand
that this applies as user update cells. You would need to loop through
current cells to fix current cell values.


Revised 1)

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo Worksheet_Change_Error

Const rEval = "A1:C9"

Set isect = Application.Intersect(Range(rEval), Target)
If Not isect Is Nothing Then
If Len(Target.Value) > 30 Then
Target.Value = Left(Target.Value, 30)
MsgBox ("Value must not exceed 30." & vbCrLf & _
"Entered data trimmed.")
End If

End If
Exit Sub

Worksheet_Change_Error:

Select Case Err
Case 13
'do nothing
Case Else
MsgBox Err.Number & " - " & Err.Description
End Select
End Sub

Revised 2

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo Worksheet_Change_Error

If Len(Target.Value) > 30 Then
Target.Value = Left(Target.Value, 30)
MsgBox ("Value must not exceed 30." & vbCrLf & _
"Entered data trimmed.")
End If
Exit Sub

Worksheet_Change_Error:

Select Case Err
Case 13
'do nothing
Case Else
MsgBox Err.Number & " - " & Err.Description
End Select
End Sub


Current values

Paste the following in a regular module.
Select cells required to be trimmed
Run fixCurrentRecords from your macro menu.

Sub fixCurrentRecords()

For Each C In Selection
C.Value = Left(C.Value, 30)
Next C

End Sub