On Feb 13, 12:47*pm, Ron Rosenfeld wrote:
On Fri, 13 Feb 2009 00:12:54 -0500, "Rick Rothstein"

wrote:

A couple of comments on your event code...

1) My tests show the changing the format of a cell does not kick off a
Change event, so both of your EnableEvents statement lines can be
eliminated.

Just habit, but you are correct.



2) Your "If IsNumeric(num) And num = Int(num) Then" statement will fail if
text is entered into one of the target cells (the Int function call will
fail). You can use this statement instead...

* * * * *If not num Like "*[!0-9]*" Then

* *which makes sure that a non-digit is not located anywhere within the
contents of the num variable (it handles both the IsNumeric and "is integer"
issues with one test).

I noted that also, and was going to post a correction this morning. *Yours is
succinct, but fails on ERROR values with a type mismatch error.



And here is a modification that shortens the routing by eliminating the two
Select Case blocks (but which is just a *tad* more obfuscated<g)...

I find shortened routines to be quite useful sometimes, but I prefer clarity in
this instance.

Here is my corrected routine:

=======================================
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Suffix As String
Dim c As Range
Dim num As Variant
Dim AOI As Range

Set AOI = Range("A:A") 'area to custom format

If Not Intersect(Target, AOI) Is Nothing Then
For Each c In Intersect(Target, AOI)
* * num = c.Value

If IsNumeric(num) Then
* * If num = Int(num) Then
* * Select Case Abs(num) Mod 10
* * * * Case Is = 1
* * * * * * Suffix = "st"
* * * * Case Is = 2
* * * * * * Suffix = "nd"
* * * * Case Is = 3
* * * * * * Suffix = "rd"
* * * * Case Else
* * * * * * Suffix = "th"
* * End Select
* * Select Case num Mod 100
* * * * Case 11 To 19
* * * * * * Suffix = "th"
* * End Select
* * c.NumberFormat = "#,##0" & """" & Suffix & """"
* * End If
* * * * Else
* * * * * * c.NumberFormat = "General"
End If

Next c
End If
End Sub
====================================

and here is another in case some of the entries in the range to be formatted
might be the results of formulas, since target will no longer be within the
area of interest:

======================
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Suffix As String
Dim num As Variant
Dim c As Range
Dim AOI As Range

Set AOI = Range("A:A") 'area to custom format

If Not Intersect(Target, AOI) Is Nothing Then
* * For Each c In Intersect(Target, AOI)
* * * * num = c.Value
* * If IsNumeric(num) Then
* * * * If num = Int(num) Then
* * * * * * c.NumberFormat = "#,##0" & """" & Ord(num) & """"
* * * * Else
* * * * * * c.NumberFormat = "General"
* * * * End If
* * End If
* * Next c
End If

On Error Resume Next
For Each c In AOI.SpecialCells(xlCellTypeFormulas, xlNumbers)
* * * * num = c.Value
* * * * If num = Int(num) Then
* * * * * * c.NumberFormat = "#,##0" & """" & Ord(num) & """"
* * * * Else
* * * * * * c.NumberFormat = "General"
* * * * End If
* * Next c
On Error GoTo 0
End Sub

Private Function Ord(num) As String
* * Select Case Abs(num) Mod 10
* * * * Case Is = 1
* * * * * * Ord = "st"
* * * * Case Is = 2
* * * * * * Ord = "nd"
* * * * Case Is = 3
* * * * * * Ord = "rd"
* * * * Case Else
* * * * * * Ord = "th"
* * End Select
* * Select Case num Mod 100
* * * * Case 11 To 19
* * * * * * Ord = "th"
* * End Select

End Function
==================================
--ron

If you want to work from a date, not just a number then i have put
together a formula...

A1 =
01/01/2009

B1 =
=IF(LEFT(TEXT(A1,"dd"),1)="0",MID(TEXT(A1,"dd"),2, 1),LEFT(TEXT
(A1,"dd"),2))&IF(AND(MOD(LEFT(TEXT(A1,"dd"),2),100 )=10,MOD(LEFT(TEXT
(A1,"dd"),2),100)<=14),"th",CHOOSE(MOD(LEFT(TEXT(A 1,"dd"),2),
10)+1,"th","st","nd","rd","th","th","th","th","th" ,"th"))

Note: This is made for European date format.