Format Cell Value to Ten Characters

Gos-C

Active Member
Joined
Apr 11, 2005
Messages
258
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi all,

I have the following code which formats the cell values in column A to 10 characters on entry:

Code:
Sub FormatToTenCharacters()
   Dim Cell As Range, LR As Long
   LR = Range("A" & Rows.Count).End(xlUp).Row
   For Each Cell In Range("A1:A" & LR)
        If Len(Cell.Value) < 10 Then Cell.Value = "'" & Application.Rept("0", 10 - Len(Cell.Value)) & UCase(Cell.Value)
    Next Cell
End Sub

For example:

Enter excel in A1 and it changes to '00000EXCEL
Enter 123456 in A2 and it changes to '0000123456
Enter abc456 in A3 and it changes to '0000ABC456

I want to format it as text so that it does not have the apostrophe ('). Any help?

Thank you,
Gos-C
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Does this work for you
Code:
Sub test()
    Dim oneCell As Range
    With ThisWorkbook.Sheets("Sheet1").Range("A:A")
        For Each oneCell In Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
            With oneCell
                oneCell.NumberFormat = "general"
                If Len(.Text) < 10 Then
                    .NumberFormat = ";;;" & Chr(34) & String(10 - Len(CStr(.Value)), "0") & Chr(34) & "@"
                End If
            End With
        Next oneCell
    End With
End Sub
 
Upvote 0
Perhaps this
Code:
Sub FormatToTenCharacters()
   Dim Cell As Range, LR As Long
   LR = Range("A" & Rows.Count).End(xlUp).Row
   For Each Cell In Range("A1:A" & LR)
        If Len(Cell.Value) < 10 Then 
            Cell.NumberFormat = "@"
            Cell.Value = String("0", 10 - Len(Cell.Value)) & UCase(Cell.Value)
        End If
    Next Cell
End Sub
 
Upvote 0
Hi mikerickson,

Guided by your suggestion, I modified the code as follows:

Code:
Sub FormatToTenCharacters()
   Dim Cell As Range, LR As Long
   LR = Range("A" & Rows.Count).End(xlUp).Row
   For Each Cell In Range("A1:A" & LR)
        Cell.NumberFormat = "@"
            If Len(Cell.Value) < 10 Then Cell.Value = Application.Rept("0", 10-Len(Cell.Value)) & UCase(Cell.Value)
    Next Cell
End Sub

Now it is working perfectly.

Thank you very much,
Gos-C
 
Upvote 0
The following formats the cell value on entry:

Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub 'only works in Columns A
Target.NumberFormat = "@"
            If Len(Target.Value) <= 10 Then Target.Value = Application.Rept("0", 10 - Len(Target.Value)) & UCase(Target.Value)
End Sub

Regards,
Gos-C
 
Upvote 0
Hi,

I thought that my code was working "perfectly", but now I am encountering some problems when I use it for column K of a protected worksheet.

I am getting:

Run-time error '1004':
Unable to set the NumberFormat property of the Range Class

Here is the modified code I am using:

Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Column <> 11 Then Exit Sub 'only works in Columns K
        If Target <> "" Then
        Target.NumberFormat = "@"
        If Len(Target.Value) <= 10 Then Target.Value = Application.Rept("0", 10 - Len(Target.Value)) & UCase(Target.Value)
    End If
Application.EnableEvents = True
End Sub

Can you tell me how to fix it?

Thank you,
Gos-C
 
Upvote 0
Like this?

Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Column <> 11 Then Exit Sub 'only works in Columns K
        [COLOR="Blue"]If Target.Count > 1 Then Exit Sub[/COLOR]
            If Target <> "" Then
    Target.NumberFormat = "@"
        If Len(Target.Value) <= 10 Then Target.Value = Application.Rept("0", 10 - Len(Target.Value)) & UCase(Target.Value)
    End If
Application.EnableEvents = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,215
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top