Custom Validation

T

tkaplan

I have a merged range of cells B9:I9. I have a cell named TextLengt
with the formula Len(B9) and a cell named TooLong with the formul
MID(B9,1100,50).
Here's what I am trying to do:
When the user updates the cell, if he goes past 1150 characters (th
cell will not display past that) i would like a message box to pop u
telling them:
"The cell has reached its maximum limit. Please delete everything afte
" & TooLong & " and go to the next row".

I would like the text of TooLong to be either in a different color, o
bold but if that's not possilbe then in quotes.
The purpose of this is because the user won't realize why the entir
text is not displayed in the cell, only formula bar, so this way i
will tell them that they went over and at what point they went over.
I know that i can do validation for the length but i want to includ
the text that hit the limit.

Any help would be appreciated.

Thank you
 
D

Dave Peterson

I think I would drop Data|Validation and use a worksheet event instead.

If you want to try it, right click on the worksheet tab that should have this
behavior. Select view code and paste this into the code window:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim maxLen As Long
Dim TruncatedText As String
maxLen = 1100

If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Me.Range("b9")) Is Nothing Then Exit Sub

On Error GoTo errHandler:

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)
'or
'target.value = ""
End If

errHandler:
Application.EnableEvents = True

End Sub


If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

If you want to read more about these kinds of events:

Chip Pearson's site:
http://www.cpearson.com/excel/events.htm

David McRitchie's site:
http://www.mvps.org/dmcritchie/excel/event.htm

==============
You may want to teach your users that by adding alt-enters every 80 to 100
characters, then way more than 1100 characters will be able to be seen in that
cell. You may have to make the font smaller when you get really long strings.
 
T

tkaplan

Thanks Dave for your help.

I am usually pretty okay with macros but there are some key words tha
i dont know what they are and that prevents me from knowing how to d
these things.

This works perfectly (i actually added a line that puts the truncate
text into the next line). can you please explain to me the followin
lines of code from your code below so that i can better understan
what's happening?

If Target.Cells.Count > 1 Then Exit Sub --what does target.cells.coun
test for?

If Intersect(Target, Me.Range("b9")) Is Nothing Then Exit Sub -- wha
is intersect function check for?

also, what is vbLf?

Thank you so much for your assistance.
tkapla
 
D

Dave Peterson

Target represents the range you just changed.

If target.cells.count > 1 then exit sub

means that if you changed more than one cell then get out of the subroutine.

You can change more than one cell by selecting a multicell range and typing
something, then hitting ctrl-enter--or hitting the delete key to clear the
contents.

If you want to limit the range to inspect to a single cell, you could use:

if target.address <> "$B$9" then exit sub

But if you're going to keep adding more and more cells to check, then I find it
easier to just look to see if the intersection (the cells in common in both
ranges) is actually something.

if intersect(target,me.range("a:a,b13:c99,e44")) is nothing then...

would check all of column A, b13:c99 and E44.

Do you remember your Venn diagrams from math?
If the two circles don't overlap at all, then the intersection is nothing.
 
T

tkaplan

HELP!
This was working before just fine now all of the sudden it stoppe
working.
any ideas as to why that would happen??? i tried deleting all the cod
and pasting again and it still doesnt work. it's not entering th
change event at all
 
D

Dave Peterson

If you were testing the code (stepping through it after setting a breakpoint??),
then maybe you didn't let the last couple of lines run.

In the VBE.
ctrl-g to see the immediate window
type this and hit enter:
application.enableevents = true
 
T

tkaplan

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.
 
D

Dave Peterson

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.
 
Top