Format Cell Value to Ten Characters

[Gos-C]

Hi all,

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

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

 

[mikerickson]

Does this work for you

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

 

[Gos-C]

No, =LEN(A1) must equal 10.

 

[mikerickson]

Perhaps this

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

 

[Gos-C]

ADVERTISEMENT

Hi mikerickson,

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

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

 

[Gos-C]

The following formats the cell value on entry:

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

 

[Gos-C]

ADVERTISEMENT

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:

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

 

[mikerickson]

That code needs to be modified to test that Target is only one cell.

 

[Gos-C]

Like this?

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

 

[mikerickson]

Does that work for you?