limiting characters in a cell

[abouassi]

hello, please help!!!
briefly,i have to enter data in an excel worksheet,and after that, i have to cope everything and paste it in another program( AS/400 this is not important) ,and the problem is that the AS/400 needs to have specific number of characters in every column, what i want to do , is to write a function, or a small program in VBA so that i can identify the number of characters in every column..
1.going to data>validation>text length ... doesnt work, cause i want it to erase automatically what is beyond the length needed
2. the function LEFT(A1;10) for example is not working in my excel 2002, i don't know why, maybe if it works it would be great,but it 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 cell in the column 2 (in this example) it is giving me an error, moreover,i don't know how to write it in order to program many columns at the same time...
thanks for help

[Dave Peterson]

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:D9, 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.

abouassi wrote:
>
> hello, please help!!!
> briefly,i have to enter data in an excel worksheet,and after that, i
> have to cope everything and paste it in another program( AS/400 this is
> not important) ,and the problem is that the AS/400 needs to have
> specific number of characters in every column, what i want to do , is
> to write a function, or a small program in VBA so that i can identify
> the number of characters in every column..
> 1.going to data>validation>text length ... doesnt work, cause i want it
> to erase automatically what is beyond the length needed
> 2. the function LEFT(A1;10) for example is not working in my excel
> 2002, i don't know why, maybe if it works it would be great,but it
> 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 cell
> in the column 2 (in this example) it is giving me an error, moreover,i
> don't know how to write it in order to program many columns at the same
> time...
> thanks for help
>
> --
> abouassi
> ------------------------------------------------------------------------
> abouassi's Profile: http://www.excelforum.com/member.php...o&userid=37591
> View this thread: http://www.excelforum.com/showthread...hreadid=572165

--

Dave Peterson

[Ken Johnson]

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]

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]

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

[abouassi]

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]

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




abouassi wrote:
>
> 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
> ------------------------------------------------------------------------
> abouassi's Profile: http://www.excelforum.com/member.php...o&userid=37591
> View this thread: http://www.excelforum.com/showthread...hreadid=572165

--

Dave Peterson

[Ken Johnson]

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]

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 =E9crit :

> 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 =3D False
> Dim rngCell As Range
> On Error Resume Next
> For Each rngCell In Target
> rngCell.Value =3D Left(rngCell.Value, 10)
> Next rngCell
> Application.EnableEvents =3D True
> Case Else
> End Select
> End Sub
>=20
> Ken Johnson

[AAA]

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]

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

[Dave Peterson]

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

AAA wrote:
>
> 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 :
>
> > 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

--

Dave Peterson

[Dave Peterson]

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

AAA wrote:
>
> 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 :
>
> > 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

--

Dave Peterson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Hi,

I'm sure Dave's solutions are the way to go.
Here's mine just for fun:-)

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
If Len(rngCell.Value) < iNumChars Then
rngCell.Value = rngCell.Value & _
Space(iNumChars - Len(rngCell.Value))
Else: rngCell.Value = Left(rngCell.Value, iNumChars)
End If
Next rngCell
Application.EnableEvents = True
Case Else
End Select
End Sub


Ken Johnson

[Ken Johnson]

Bloody Server Errors!

Ken Johnson

[AAA]

good morning..
concerning the empty cell, yes, i want to fill it with white spaces
too, and the code down solves this problem,but i still have a small
problem,"see down":
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

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, 2, 3, 4) 'A, E, L
myLengths = Array(20, 30, 13, 10)


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
""""""""""""""""""""""""""""""""""""""""""""""""""""""""
this code works very good, the only problem i'm facing is that when the
data in a cell is of type " standard" or " number" or anything
else,filling the rest of the characters with empty space is not
working.Only when its in the form of a text, do i always have to change
it to text to use it, or there is a way...
one more question, when i copy data from excel to word, a tab(big empty
space) instead of the lines seperating the columns always exsits, is
it possible to remove it..
thank you a lot, promise to stop bothering you with my problem.

[Ken Johnson]

Hi AAA,

a possible solution to your first problem is to either manually format
your columns as Text or insert...

myCell.NumberFormat = "@"

into the code so that numbers are actually text and the spaces are
added.

If you decide to do the formatting with the code then your new code
will be...

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, 2, 3, 4) 'A, E, L
myLengths = Array(10, 3, 20, 10)

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.NumberFormat = "@" 'added to format cell as Text
myCell.Value _
= Left(myCell.Value & Space(myLengths(iCol)), _
myLengths(iCol))
Next myCell
Application.EnableEvents = True
On Error GoTo 0

End Sub

Sorry I don't know about your other problem.

Ken Johnson

[Dave Peterson]

Just to add to Ken's response.

You may want to use the .text property (for dates???).

myCell.NumberFormat = "@" 'added to format cell as Text
myCell.Value _
= Left(myCell.Text & Space(myLengths(iCol)), _
myLengths(iCol))

=====
And I don't know the answer about the MSWord question. Maybe running
Table|convert after pasting would be sufficient?????

Ken Johnson wrote:
>
> Hi AAA,
>
> a possible solution to your first problem is to either manually format
> your columns as Text or insert...
>
> myCell.NumberFormat = "@"
>
> into the code so that numbers are actually text and the spaces are
> added.
>
> If you decide to do the formatting with the code then your new code
> will be...
>
> 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, 2, 3, 4) 'A, E, L
> myLengths = Array(10, 3, 20, 10)
>
> 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.NumberFormat = "@" 'added to format cell as Text
> myCell.Value _
> = Left(myCell.Value & Space(myLengths(iCol)), _
> myLengths(iCol))
> Next myCell
> Application.EnableEvents = True
> On Error GoTo 0
>
> End Sub
>
> Sorry I don't know about your other problem.
>
> Ken Johnson

--

Dave Peterson

[Ken Johnson]

Hi AAA,

before you paste into Word you could insert into Word a suitable sized
table. Before you paste into the table select all the table cells so
that it's not all pasted into the one cell.
You could then format the table using the Borders and shading dialog.

Ken Johnson

[AAA]

hi again,
i just want to thank you very much,
i work in a french company, they were about to pay more than 500 euros
to do a project, and the code you gave me makes it very easy..u deserve
that money (anyway,i didn't take it)
thanks a lot

Ken Johnson a =E9crit :

> Hi AAA,
>
> before you paste into Word you could insert into Word a suitable sized
> table. Before you paste into the table select all the table cells so
> that it's not all pasted into the one cell.
> You could then format the table using the Borders and shading dialog.
>=20
> Ken Johnson

[Ken Johnson]

Hi AAA,
You're welcome.
Thanks for those kind words.
Ken Johnson