limiting characters in a cell

abouassi · Aug 16, 2006

hello, please help!!!
briefly,i have to enter data in an excel worksheet,and after that,
have to cope everything and paste it in another program( AS/400 this i
not important) ,and the problem is that the AS/400 needs to hav
specific number of characters in every column, what i want to do , i
to write a function, or a small program in VBA so that i can identif
the number of characters in every column..
1.going to data>validation>text length ... doesnt work, cause i want i
to erase automatically what is beyond the length needed
2. the function LEFT(A1;10) for example is not working in my exce
2002, i don't know why, maybe if it works it would be great,but i
seems that excel is not recognising it
3.in VBA

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
Target = Left(Target, 2)
End Sub
is working,but i when i paste more than one cell in more than one cel
in the column 2 (in this example) it is giving me an error, moreover,
don't know how to write it in order to program many columns at the sam
time...
thanks for hel

Dave Peterson · Aug 16, 2006

Do you want to limit it 10 characters or 2 characters?

=left(a1,10) is 10 (I use a comma in my USA version)

target = left(target,2) is only 2 characters.

In either case, maybe this will help:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRngToCheck As Range
Dim myCell As Range

Set myRngToCheck = Me.Range("b:b,c3:d9,x:x,Q:S")

If Intersect(Target, myRngToCheck) Is Nothing Then
Exit Sub
End If

On Error Resume Next 'just keep going!
Application.EnableEvents = False
For Each myCell In Intersect(Target, myRngToCheck).Cells
myCell.Value = Left(myCell.Value, 10)
Next myCell
Application.EnableEvents = True
On Error GoTo 0

End Sub

I checked all of column B, just the cells in C3

9, all of column X and all the
cells in columns Q:S.

You can modify that the way you need.

I'd add some more checks--ignore numbers, dates, anything you need to ignore.

Ken Johnson · Aug 16, 2006

Hi,

This operates on all pasted cells in columns 2,3,4,5,8 and 9. Just edit
to suit your needs

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 2, 3, 4, 5, 8, 9
Application.EnableEvents = False
Dim rngCell As Range
On Error Resume Next
For Each rngCell In Target
rngCell.Value = Left(rngCell.Value, 10)
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub

Ken Johnson

abouassi · Aug 16, 2006

thanks a lot for your help, you have solved half of my problem
the other part is because i don't know a lot in VBA(just how to write)
and it concerns how can i associate in the same code(or in different
codes)for every column different number of characters..anyways,i don't
have a lot of columns(about 10) so i can do it manually..the code you
gave me works perfectly well for only one column...
for example
i need column A to have 20 characters
column B to have 1 character
column C to have 19 character
.......
.......
and so on...
i appreciate your help, thank you

abouassi · Aug 16, 2006

for the numbers i used 10 and 2 , they were just examples, i can manage
changing the numbers later...
thank you

abouassi · Aug 16, 2006

hi again
the code Mr Ken Johnson gave me functions very good too, but still a
problem,
in this code i'm able to identify which columns i need, but what i need
is to associate for every column different length
example :
for column A -> 20 characters
for column B -> 3 characters
for column C -> 10 characters
....
....
don't worry for the numbers 20 , 3, 10, they are just examples, i can
manage changing them later
thank you

Dave Peterson · Aug 16, 2006

First, please respond to your other thread in .misc that you have an active
thread in .programming. There is no reason to have other people work on a
solution if you find one here. And there is no reason for others to work on a
response here if you get a solution from that other post.

It's not fair to the responders to multipost like this.

But this seemed to work ok for me:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRngToCheck As Range
Dim myCell As Range
Dim myLengths As Variant
Dim myCols As Variant
Dim iCol As Long

myCols = Array(1, 5, 12) 'A, E, L
myLengths = Array(10, 2, 5)

Set myRngToCheck = Me.Columns(myCols(LBound(myCols)))
For iCol = LBound(myCols) + 1 To UBound(myCols)
Set myRngToCheck = Union(myRngToCheck, Me.Columns(myCols(iCol)))
Next iCol

If Intersect(Target, myRngToCheck) Is Nothing Then
Exit Sub
End If

On Error Resume Next 'just keep going!
Application.EnableEvents = False
For Each myCell In Intersect(Target, myRngToCheck).Cells
'the arrays are 0 based, so we subtract 1 from the match
iCol = Application.Match(myCell.Column, myCols, 0) - 1
If Len(myCell.Value) > myLengths(iCol) Then
myCell.Value = Left(myCell.Value, myLengths(iCol))
End If
Next myCell
Application.EnableEvents = True
On Error GoTo 0

End Sub

Ken Johnson · Aug 16, 2006

Hi,

This incorporates the change you are looking for, just edit "Case 1, 2,
3" and add extra Cases to suit your needs.
For example if column 5 (E) is to have 12 characters then...

line 3 becomes Case 1, 2, 3, 5

and after the 16th line add...
Case 5
iNumChars = 12

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 1, 2, 3 'Edit to suit your needs
Application.EnableEvents = False
Dim rngCell As Range
Dim iNumChars As Integer
On Error Resume Next
For Each rngCell In Target
Select Case rngCell.Column
'Add extra Cases and edit to suit your needs
Case 1
iNumChars = 20
Case 2
iNumChars = 3
Case 3
iNumChars = 10
End Select
rngCell.Value = Left(rngCell.Value, iNumChars)
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub

Ken Johnson

AAA · Aug 17, 2006

hi,i'm sorry for working in both forums, infact , this is the first
time i use it, and i didn't know that they are the same...
everything is working great, but forgive me, i still have a small
problem that i've just noticed. is it possible if the number of
characters in a cell is less than a specifique number , to fill the
rest with an empty space...
example
column A contains 7 characters, if i insert
"hello world" i have to get "hello w" (without the quotations)
and if i insert
"be" i get "be "

thanks a lot people, you are great

Ken Johnson a écrit :

AAA · Aug 17, 2006

hi again,if you still have patiency to reply me, a test to make sure
that a program works is to copy data from an excel file, after fixing
the lengths, in a word file, and to have the result in a word as
follows ( example:

A-----------------------B----------C----------------------D--------------
qqqqqqqq xxx ttttttttttttttttttt vvvvvvvvvvvv
qqqqqqqqqqqqqq xxx ttttt vvv
qqq x vvvvvvvvvv
qqqqqq xxxxxxxx ttttttttttttttttt v

A,B,C and D are just the names of the columns,and the " - " are just to
show the length of every column,and the idea is that every column have
a specifique length, if i enter a data in a cell which has more
characters than the length of the cell itself, it has to be reduced to
the length associated, and if the number of characters of the word i'm
entering is less than the length, white spaces are to be filled,...

i appreciate your help, thanks very much

abouassi · Aug 17, 2006

hi again,the form of the text i've writing has changed, i hope you go
my idea..thank

Dave Peterson · Aug 17, 2006

This worked ok for me:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRngToCheck As Range
Dim myCell As Range
Dim myLengths As Variant
Dim myCols As Variant
Dim iCol As Long

myCols = Array(1, 5, 12) 'A, E, L
myLengths = Array(10, 2, 5)

Set myRngToCheck = Me.Columns(myCols(LBound(myCols)))
For iCol = LBound(myCols) + 1 To UBound(myCols)
Set myRngToCheck = Union(myRngToCheck, Me.Columns(myCols(iCol)))
Next iCol

If Intersect(Target, myRngToCheck) Is Nothing Then
Exit Sub
End If

On Error Resume Next 'just keep going!
Application.EnableEvents = False
For Each myCell In Intersect(Target, myRngToCheck).Cells
'the arrays are 0 based, so we subtract 1 from the match
iCol = Application.Match(myCell.Column, myCols, 0) - 1
myCell.Value _
= Left(myCell.Value & Space(myLengths(iCol)), myLengths(iCol))
Next myCell
Application.EnableEvents = True
On Error GoTo 0

End Sub

Dave Peterson · Aug 17, 2006

Or maybe this one:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRngToCheck As Range
Dim myCell As Range
Dim myLengths As Variant
Dim myCols As Variant
Dim iCol As Long

myCols = Array(1, 5, 12) 'A, E, L
myLengths = Array(10, 2, 5)

Set myRngToCheck = Me.Columns(myCols(LBound(myCols)))
For iCol = LBound(myCols) + 1 To UBound(myCols)
Set myRngToCheck = Union(myRngToCheck, Me.Columns(myCols(iCol)))
Next iCol

If Intersect(Target, myRngToCheck) Is Nothing Then
Exit Sub
End If

On Error Resume Next 'just keep going!
Application.EnableEvents = False
For Each myCell In Intersect(Target, myRngToCheck).Cells
'the arrays are 0 based, so we subtract 1 from the match
iCol = Application.Match(myCell.Column, myCols, 0) - 1
If Trim(myCell.Value) = "" Then
'leave it alone
Else
myCell.Value _
= Left(myCell.Value & Space(myLengths(iCol)), myLengths(iCol))
End If
Next myCell
Application.EnableEvents = True
On Error GoTo 0

End Sub

I don't know what should happen if you clear the contents of one of those
cells. Should that be left alone or padded with spaces????

Ken Johnson · Aug 18, 2006