Custom Number Formats

[thbutterflycollector_]

HI,

I have some cells in excel I would like to format as per the following typical entries I will be making

1 / A
1 / B
etc...
1 / 1 / A
1 / 1 / B
1 / 1 / C
etc...
1 / 1 / 1 A
1 / 1 / 1 B
1 / 1 / 1 C

Etc.

The numerical data is based on sections or subsections and there may be only one or more than one subsection at any time. The letter reference refers to the unique item on that page.

I can get as far as “# "/" # "/"” in the custom number format but I cannot get any further as it does not give me any flexibility with the other scenarios. Does anybody have any suggestions?

 

[Scott Huish]

I'm assuming you want to enter them as 1A, 111A, etc. I think you will need VBA for this.
I have also added the functionality of making the letters uppercase so that you don't have to enter them that way.
This will actually change the value to be in that format.

This works for Column A, change as necessary.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, d As Range, x As Long
Set d = Intersect(Target, Range("A:A"))
If d Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each c In d
    c = Subsection(c.Text)
Next
Application.EnableEvents = True
End Sub

Function Subsection(r As String) As String
Dim x As Long, s As String
For x = 1 To Len(r)
    s = s & Mid(r, x, 1) & " / "
Next
If Len(s) > 3 Then Subsection = UCase(Left(s, Len(s) - 3))
End Function

 

[Rick Rothstein]

I'm assuming you want to enter them as 1A, 111A, etc. I think you will need VBA for this.
I have also added the functionality of making the letters uppercase so that you don't have to enter them that way.
This will actually change the value to be in that format.

This works for Column A, change as necessary.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, d As Range, x As Long
Set d = Intersect(Target, Range("A:A"))
If d Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each c In d
    c = Subsection(c.Text)
Next
Application.EnableEvents = True
End Sub

Function Subsection(r As String) As String
Dim x As Long, s As String
For x = 1 To Len(r)
    s = s & Mid(r, x, 1) & " / "
Next
If Len(s) > 3 Then Subsection = UCase(Left(s, Len(s) - 3))
End Function

If the OP is interested, there is a one-liner function available for Scott's Subsection function...

[table="width: 500"]
[tr]
	[td]Function Subsection(S As String) As String
  Subsection = UCase(Replace(Trim(Replace(StrConv(S, vbUnicode), Chr(0), " ")), " ", " / "))
End Function[/td]
[/tr]
[/table]

And since it is a one-liner, the Subsection function could be eliminated entirely and this single line of code could be used directly in the For Each loop of Scott's Change event procedure instead. For example...

[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range, d As Range, x As Long
  Set d = Intersect(Target, Range("A:A"))
  If d Is Nothing Then Exit Sub
  Application.EnableEvents = False
  For Each c In d
    c = UCase(Replace(Trim(Replace(StrConv(c.Text, vbUnicode), Chr(0), " ")), " ", " / "))
  Next
  Application.EnableEvents = True
End Sub[/td]
[/tr]
[/table]

 

[Scott Huish]

That is very interesting. That could come in handy for all sorts of things.