View Single Post
  #8   Report Post  
Dave Peterson
 
Posts: n/a
Default Custom Validation

Excel doesn't really make much of a word processor--but if you're going to do
this, you really should try the alt-enter stuff. You'll be able to see lots
more in that cell. (I'm not lying to you!)

But this worked in simple testing:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim maxLen As Long
Dim myRngToInspect As Range
Dim myCell As Range
Dim TruncatedText As String
Dim cCtr As Long
maxLen = 1100

If Target.Cells.Count 1 Then Exit Sub
Set myRngToInspect = Me.Range("B9:B11")

If Intersect(Target, myRngToInspect) Is Nothing Then Exit Sub

On Error GoTo errHandler:
Application.EnableEvents = False

cCtr = 0
For Each myCell In myRngToInspect.Cells
cCtr = cCtr + 1
If Len(myCell.Value) <= maxLen Then
Exit For
End If

'save the chopped portion
TruncatedText = Mid(myCell.Value, maxLen + 1)

'put the truncated text back
myCell.Value = Left(myCell.Value, maxLen)
If cCtr = myRngToInspect.Cells.Count Then
'on the last cell
MsgBox "Cell: " & myCell.Address(0, 0) & " has been truncated!" _
& vbLf & TruncatedText & vbLf & "was chopped!"
Else
'put the truncated text at the beginning of the next cell
myCell.Offset(1, 0).Value _
= TruncatedText & myCell.Offset(1, 0).Value
End If
Next myCell

errHandler:
Application.EnableEvents = True

End Sub

=======
I changed this:
maxLen = 1100
to
maxLen = 10

for testing purposes.



tkaplan wrote:

oops...now i feel stupid. i had two the application open twice. i closed
out and now it works:)

expanding on the code that you provided for me, i would like to modify
it as follows (this would only apply to cells b9,10,11 because all
other cells are locked so user cannot make changes anyways.)

the truncated text from cell b9 should be appended to the beginning of
cell b10. but then if after that change b10 becomes too long, i want
that text to be appended to cell b11. if cell b11 becomes too long, i
would like a message box prompting the user to send additional comments
in a seperate file and truncate after the max length.

so here's what i have.
If Len(Target.Value) maxLen Then
TruncatedText = Mid(Target.Value, maxLen + 1)
MsgBox "Cell: " & Target.Address(0, 0) & " has been truncated!" _
& vbLf & TruncatedText & vbLf & "was chopped!"
Application.EnableEvents = False
Target.Value = Left(Target.Value, maxLen)
Target.Activate
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Address = "$B$12" Then
MsgBox ("You have reached the limit for the comments." &
vbNewLine & "Please attach any additional comments in a seperate
file.")
Else
ActiveCell.Value = TruncatedText & vbLf & ActiveCell.Value
End If
End If

This works to append the text. the part i dont know how to do is how to
test and check to see if the new cell is too long, to loop through this
process again. i figure it would be a loop while cell length max
length, just not sure how to implement.

THank you.

--
tkaplan
------------------------------------------------------------------------
tkaplan's Profile: http://www.excelforum.com/member.php...o&userid=22987
View this thread: http://www.excelforum.com/showthread...hreadid=483601


--

Dave Peterson