S
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
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