limiting characters in a cell

K

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
 
K

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
 
K

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
 
K

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
 
K

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
 
K

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
 
K

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
 
K

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
 
K

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
 
A

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

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
 
D

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

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
 
A

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

limiting characters in a cell 1
No characters data in Hyperlink cell 3
Problem limiting characters 7
limiting column selection 2
Excel [VBA] Check from a cell into another sheet and bring back result in MsgBox 0
Change in cell content alert 1
How replace a character in a string of characters? 6
Trying to run excel vba code when cell value changes from empty to entered value. 1

Top