Adding Ordinal Notation to Dates

@Jacob van Vaardegem

Here is a macro that implements your excellent suggestions (2019-10-19 and 2019-10-24) for ordinal dates by Conditional Format:

Public Sub OrdinalDateCF()
Dim msg As String, ans As String, fmt As String
Dim addr As String, expr As String
Dim n1 As Integer, n2 As Integer, nod As Integer
Const myName As String = "OrdinalDateCF"
Const quote As String = """"
msg = "To display ordinal dates in the Selection using a " _
& "Conditional Format, enter a date format using:" _
& vbNewLine & "mmmm for full month name," _
& vbNewLine & "mmm for abbreviated month," _
& vbNewLine & "mm for 2-digit month," _
& vbNewLine & "m for month number," _
& vbNewLine & "od for ordinal day number," _
& vbNewLine & "yyyy for year number," _
& vbNewLine & "yy for 2-digit year." _
& vbNewLine & "Include a time format if desired." _
& vbNewLine _
& vbNewLine & "Example ... Result" _
& vbNewLine & "od-mmm-yyyy ... 7th-Dec-1941" _
& vbNewLine & "mmmm od, yy ... June 6th, 44" _
& vbNewLine & "m/od/yyyy ... 9/11th/2001" _
& vbNewLine & "mmmm od ... December 31st" _
& vbNewLine & "od"" of ""mmmm ... 4th of July"
ans = InputBox(msg, myName, "mmmm od, yyyy")
If ans = vbNullString Then Exit Sub
n2 = 0
Do
nod = InStr((n2 + 1), ans, "od")
If nod = 0 Then
msg = "Error: The date format must include" _
& vbNewLine & "od for ordinal day number."
MsgBox msg, vbCritical, myName
Exit Sub
End If
n1 = InStr((n2 + 1), ans, quote)
If (n1 > 0 And n1 < nod) Then ' ignore od within a quoted string
n2 = InStr((n1 + 1), ans, quote)
Else
n2 = n1
End If
Loop Until (n2 = 0 Or n1 > nod Or n2 < nod)
msg = Left(ans, (nod - 1))
fmt = msg & Replace(ans, "od", "d""th""", nod, 1)
On Error Resume Next
Selection.NumberFormat = fmt
If Err <> 0 Then
msg = "Error: This date format is invalid." & vbNewLine & ans
MsgBox msg, vbCritical, myName
Exit Sub
End If
On Error GoTo 0
addr = Selection.Cells(1, 1).Address(False, False)
expr = "=OR(DAY(" & addr & ")=3,DAY(" & addr & ")=23)"
fmt = msg & Replace(ans, "od", "d""rd""", nod, 1)
Call OrdinalDateCF_Do(expr, fmt)
expr = "=OR(DAY(" & addr & ")=2,DAY(" & addr & ")=22)"
fmt = msg & Replace(ans, "od", "d""nd""", nod, 1)
Call OrdinalDateCF_Do(expr, fmt)
expr = "=OR(DAY(" & addr & ")=1,DAY(" & addr & ")=21,DAY(" & addr & ")=31)"
fmt = msg & Replace(ans, "od", "d""st""", nod, 1)
Call OrdinalDateCF_Do(expr, fmt)
End Sub

Private Sub OrdinalDateCF_Do(expr As String, fmt As String)
With Selection.FormatConditions.Add(xlExpression, , expr)
.NumberFormat = fmt
.SetFirstPriority
.StopIfTrue = True
End With
End Sub

To display automatically the day with suffix while preserving the ability to use the dates in calculations can be done by using a change event macro:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
If Not IsDate(Target) Then Exit Sub
Dim Ord As String
Select Case Day(Target)
Case 1, 21, 31: Ord = "st"
Case 2, 22: Ord = "nd"
Case 3, 23: Ord = "rd"
Case Else: Ord = "th"
End Select
Target.NumberFormat = "d""" & Ord & """ mmmm yyyyy"
End Sub

This macro acts on column A.
Remember: this macro must reside in the code page of the sheet. Right click the sheet name and select View Code. That's the place to be.

Conditional formatting
I had hoped to use somethng like the following for the formula
=OR(DAY(A1)={1,21,31})
but alas Excel won't accept arrays in CF. The following will do the trick

st =OR(DAY(A1)=1,DAY(A1)=21,DAY(A1)=31)
nd =OR(DAY(A1)=2,DAY(A1)=22)
rd =OR(DAY(A1)=3,DAY(A1)=23)
th =NOT(OR(DAY(A1)=1,DAY(A1)=2,DAY(A1)=3,DAY(A1)=21,DAY(A1)=22,DAY(A1)=23,DAY(A1)=31))

Still, a nice hour passed thinking:-)

Further to Peter's post

The macro is handy, but the downside is that if/when any of the dates change, you'll have to re-apply the macro (every time). Obviously you would want to link this to a button then.
With Conditional formatting the formats get applied automatically, irrespective of the (changed) values. And you can still sort and calculate with them.

If it is too much work to create those Conditional format rules manually, you can also combine your method with mine and create a macro that will apply a set of conditional formats to a desired range of cells. I haven't actually supplied that code here, but that can certainly be done.

Further to Jacob van Gaardegem's post

I prefer this method to formatting dates as you do not loose the abiltity to sort or run calculations with the dates. Here, for anyone interested, is a macro to apply formats to selected dates.

Sub OrdDateFormat()
Dim c As Range, nDay As Integer
Dim nf1 As String, nf2 As String
Dim nf3 As String, nf4 As String
Dim bShowYear As Boolean

bShowYear = Application.InputBox("Show year in format?", "Select Format type", 0, Type:=2)
If bShowYear = 0 Then
nf1 = "d""th"" mmmm"
nf2 = "d""st"" mmmm"
nf3 = "d""nd"" mmmm"
nf4 = "d""rd"" mmmm"
Else
nf1 = "d""th"" mmm yyyy"
nf2 = "d""st"" mmm yyyy"
nf3 = "d""nd"" mmm yyyy"
nf4 = "d""rd"" mmm yyyy"
End If

For Each c In Selection
If Not IsDate(c) Then
'Do Nothing
Else
Select Case Day(c)
Case Is = 1, 21, 31
c.NumberFormat = nf2
Case Is = 2, 22
c.NumberFormat = nf3
Case Is = 3, 23
c.NumberFormat = nf4
Case Else
c.NumberFormat = nf1
End Select
End If
Next c

End Sub

Oops ! disregard my 2 previous UDF's. I have been a little hasty and didn't test them enough. Here is one that does the job correctly (still as short):

Function OrdinalDate(D As Date)
Dim Ord As String
Select Case Day(D)
Case 1, 21, 31: Ord = "st "
Case 2, 22: Ord = "nd "
Case 3, 23: Ord = "rd "
Case Else: Ord = "th "
End Select
OrdinalDate = Day(D) & Ord & Format(D, "mmmm")
End Function

If you don't want to convert the real dates into texts, and still want to be able to calculate with them, you can use Conditional Formatting to achieve the same result.
Select the range of dates you want to apply this to (and let's say the range starts in A1), and apply the normal formatting using Custom format
d"th" mmmm
This will turn all dates into something like '1th October', '2th October', etc.

Then, on the same range, apply 3 Conditional Formatting rules:
=OR(DAY(A1)=1,DAY(A1)=21,DAY(A1)=31) > for this rule set the format to Custom format d"st" mmmm
=OR(DAY(A1)=2,DAY(A1)=22) > for this rule set the format to Custom format d"nd" mmmm
=OR(DAY(A1)=3,DAY(A1)=23) > for this rule set the format to Custom format d"rd" mmmm
For each rule, set 'Stop if True'.

In this way you can just accommodate any date with the right format and can still enter them or calculate with them as normal dates.

Obviously you can copy this format, including the conditional formatting, to any other range you want to apply Ordinal Formatting for.

Here is an even shorter version:

Function OrdinalDate(D As Date)
Dim Ord As String
Ord = "th "
On Error Resume Next
Ord = Choose(Right(Day(D), 1), "st ", "nd ", "rd ")
OrdinalDate = Day(D) & Ord & Format(D, "mmmm")
End Function

The macro in this tip can be drastically shortened. Here is my simplified version:

Function OrdinalDate(D As Date)
Dim Ord As String
Select Case Right(Day(D), 1)
Case 1: Ord = "st "
Case 2: Ord = "nd "
Case 3: Ord = "rd "
Case Else: Ord = "th "
End Select
OrdinalDate = Day(D) & Ord & Format(D, "mmmm")
End Function