Conditional Formatting

[Jokah.D]

I would like to represent numbers as placements for example: 421 becomes
421st with the "st" in superscript, 32 becomes 32nd with the "nd" in
superscript.

Is there a way to do this in Excel 2007?

 

[Shane Devenshire]

Hi,

You can't actually do that with straight formatting. If you enter 421st in
a cell and to format it you will need to select the st portion of the entery
and choose Format, Cells, Font tab, Superscript. Now fill it down and you
will see what Excel can do.

You could write a macro to do this, but you can't use a formula approach
because Excel does not allow you to format part of a formula.

 

[Gord Dibben]

You could use sheet event code.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim cell As Range
For each cell in Me.Range("A1:A100") 'adjust to suit
If Application.IsNumber(cell.Value) Then
Select Case Right(cell.Value, 1)
Case 1
cell.NumberFormat = "##""st"""
Case 2
cell.NumberFormat = "##""nd"""
Case 3
cell.NumberFormat = "##""rd"""
Case Else
cell.NumberFormat = "##""th"""
End Select
End If
Next cell
End Sub

Right-click on the sheet tab and "View Code". Copy/paste the code into that
module.

Edit the range if need be then Alt + q to return to the Excel window.


Gord Dibben MS Excel MVP

 

[Jokah.D]

Thank you for your help Gord.
I adapted the code as follows to get the desired result with superscript:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim cell As Range
Dim blank As Boolean
For Each cell In Me.Range("L3:L43")
If Application.IsNumber(cell.Value) Then
Select Case Right(cell.Value, 1)
Case 0
blank = True
Case 1
cell.Value = cell.Value & "st"
blank = False
Case 2
cell.Value = cell.Value & "nd"
blank = False
Case 3
cell.Value = cell.Value & "rd"
blank = False
Case Else
cell.Value = cell.Value & "th"
blank = False
End Select
If Not blank Then
n = cell.Characters.Count - 1
cell.Characters(n, 2).Font.Superscript = True
End If
End If
Next cell
End Sub

Thank you once again friend and happy new year.

 

[Jokah.D]

Actually it can be done my friend. The code is as follows:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim cell As Range
Dim blank As Boolean
For Each cell In Me.Range("L3:L43")
If Application.IsNumber(cell.Value) Then
Select Case Right(cell.Value, 1)
Case 0
blank = True
Case 1
cell.Value = cell.Value & "st"
blank = False
Case 2
cell.Value = cell.Value & "nd"
blank = False
Case 3
cell.Value = cell.Value & "rd"
blank = False
Case Else
cell.Value = cell.Value & "th"
blank = False
End Select
If Not blank Then
n = cell.Characters.Count - 1
cell.Characters(n, 2).Font.Superscript = True
End If
End If
Next cell
End Sub

Thank you anyway for your reply

 

[Gord Dibben]

Thanks for the update.

I skipped over the "superscript" part of your original post.

Not too uncommon with me<g>

But with your code the numbers are not "formatted"

You now have text numbers that cannot be calculated. Does that matter?

Another thing I could mention. Do you have to deal with decimal numbers
like 123.45?

You could change part of the code to chop those off. 123.45 would return
123rd rather than 123.45th

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim cell As Range
Dim blank As Boolean
On Error GoTo endit
Application.EnableEvents = False
For Each cell In Me.Range("L3:L43")
If Application.IsNumber(cell.Value) Then
cell.Value = Int(cell.Value)
Select Case Right(cell.Value, 1)
Case 0
blank = True
Case 1
cell.Value = cell.Value & "st"
blank = False
Case 2
cell.Value = cell.Value & "nd"
blank = False
Case 3
cell.Value = cell.Value & "rd"
blank = False
Case Else
cell.Value = cell.Value & "th"
blank = False
End Select
If Not blank Then
n = cell.Characters.Count - 1
cell.Characters(n, 2).Font.Superscript = True
End If
End If
Next cell
endit:
Application.EnableEvents = True
End Sub



Gord

 

[Jokah.D]

There will be no decimals and the numbers require no calculation, I do
however have another problem (well 2 actually):
1) When copying to multiple sheets, only the 1st sheet works.
2) All cells in the range are tested for reformatting everytime.

I thought about using 'Activecell' to apply the formatting but unfortunately
the change event is triggered AFTER the change has taken place and the focus
has moved to the next cell which could be either the cell to the right of the
modified cell or the 1st cell of the next row.

Q. How can I reference the cell that triggered the change event as oppose to
the currently active cell?

Thank you again Gord
***********************************************************

 

[Gord Dibben]

1. What are you copying to multiple sheets?

The code itself? Should work in each sheet since there are no hard-coded
sheet names. Me.Range refers to the active sheet.

2. To stop the re-formatting of all cells in the range each time a change
is made to any cell we get rid of the For..............Next. Just the
changed cell will re-format.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim cell As Range
Dim blank As Boolean
If Not Application.Intersect(Me.Range("L3:L43"), Target) Is Nothing Then
With Target
If Application.IsNumber(.Value) Then
Select Case Right(.Value, 1)
Case 0
blank = True
Case 1
.Value = .Value & "st"
blank = False
Case 2
.Value = .Value & "nd"
blank = False
Case 3
.Value = .Value & "rd"
blank = False
Case Else
.Value = .Value & "th"
blank = False
End Select
If Not blank Then
n = .Characters.Count - 1
.Characters(n, 2).Font.Superscript = True
End If
End If
End With
End If
End Sub


Gord

 

[Jokah.D]

Silly me! I deleted a row from above the grid and a couple from the middle to
make it look better and didn't change the range accordingly! The range starts
from L2:L40 so as I was testing it on L2 the code wasn't being processed. Doh!

All is working like a dream now, you've been a great help Gord, thank you
very much.

************************************************************