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

--
abouass
-----------------------------------------------------------------------
abouassi's Profile: http://www.excelforum.com/member.php...fo&userid=3759
View this thread: http://www.excelforum.com/showthread.php?threadid=57216

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

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

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

for the numbers i used 10 and 2 , they were just examples, i can manage
changing the numbers later...
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

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


--
abouassi
------------------------------------------------------------------------
abouassi's Profile: http://www.excelforum.com/member.php...o&userid=37591
View this thread: http://www.excelforum.com/showthread...hreadid=572165

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

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

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

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

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

--
abouass
-----------------------------------------------------------------------
abouassi's Profile: http://www.excelforum.com/member.php...fo&userid=3759
View this thread: http://www.excelforum.com/showthread.php?threadid=57216

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Bloody Server Errors!

Ken Johnson

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.

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

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

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

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 écrit :

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

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