VBA Give Away - Superscript Dates

[Jack in the UK]

Hi all as a pal gave some code away i promised i would so this will sort dates i hope superscript... yes this has been about

>>>>>>>>>>>>>>>>
Sub Con_Date_Superscript_()
Dim Newdate As String
Dim day
Dim rg As Range
Dim JACK_Cell As Range
Dim JACK_Rd As Range

Set JACK_Rd = Selection
For Each JACK_Cell In JACK_Rd
If IsDate(JACK_Cell) Then
Newdate = Format(JACK_Cell, "dd mmmm yyyy")
day = (Left(Newdate, 2))

Select Case day
Case 1 '1st
Newdate = day & "st " & Format(Newdate, "mmmm yyyy")
Case 2 '2nd
Newdate = day & "nd " & Format(Newdate, "mmmm yyyy")
Case 3 '3rd
Newdate = day & "rd " & Format(Newdate, "mmmm yyyy")

For Each JACK_Cell In JACK_Rd
JACK_Cell = Newdate
With JACK_Cell.Characters(Start:=2, Length:=2).Font
.SuperScript = True
End With
'End If
Next
End

Case 21 '1st
Newdate = day & "st " & Format(Newdate, "d dddd mmmm yyyy")
Case 22 '2nd
Newdate = day & "nd " & Format(Newdate, "d dddd mmmm yyyy")
Case 23 '3rd
Newdate = day & "rd " & Format(Newdate, "d dddd mmmm yyyy")
Case 31 '1st
Case 4 To 20, 24 To 30 '9th to 30th
Newdate = day & "th " & Format(Newdate, "d dddd mmmm yyyy")
End Select

JACK_Cell = Newdate
With JACK_Cell.Characters(Start:=3, Length:=2).Font
.SuperScript = True
End With
End If
Next

End Sub

 

[Corticus]

Hey Jack,

I like the idea of your macro, but there were some problems executing it.

It converts any standard format to a superscript long format.

eg:

Dates.xls
	A	B	C	D
1	1/1/2002	>>>>>>	January 1st, 2002
2	1/3/2002	>>>>>>	January 3rd, 2002
3	2/1/2002	>>>>>>	February 1st, 2002
4	2/10/2002	>>>>>>	February 10th, 2002
5	2/25/2002	>>>>>>	February 25th, 2002
6	2/28/2002	>>>>>>	February 28th, 2002
7	3/5/2002	>>>>>>	March 5th, 2002
8	3/31/2002	>>>>>>	March 31st, 2002
...

I had to use the following code to accomplish this, hope someone can use it, it's tested and effective:

Sub Con_Date_Superscript_()

Dim Newdate As String
Dim day As Integer
Dim rg As Range
Dim JACK_Cell As Range
Dim JACK_Rd As Range
Dim MonthLength As Integer
Dim VarMonth As String

Set JACK_Rd = Selection

For Each JACK_Cell In JACK_Rd
    If IsDate(JACK_Cell) Then
        Newdate = Format(JACK_Cell, "dd mmmm yyyy")
        day = (Left(Newdate, 2))
            Select Case day
                    Case 1 '1st
                        MonthLength = Len(Format(JACK_Cell, "mmmm")) + 3
                        Newdate = Format(JACK_Cell, "mmmm") & " " & Right(day, 1) & "st, " & Year(Newdate)
                        JACK_Cell = Newdate
                            With JACK_Cell.Characters(Start:=MonthLength, Length:=2).Font
                                .Superscript = True
                            End With
                    Case 2 '2nd
                        MonthLength = Len(Format(JACK_Cell, "mmmm")) + 3
                        Newdate = Format(JACK_Cell, "mmmm") & " " & Right(day, 1) & "nd, " & Year(Newdate)
                        JACK_Cell = Newdate
                            With JACK_Cell.Characters(Start:=MonthLength, Length:=2).Font
                                .Superscript = True
                            End With
                    Case 3 '3rd
                        MonthLength = Len(Format(JACK_Cell, "mmmm")) + 3
                        Newdate = Format(JACK_Cell, "mmmm") & " " & Right(day, 1) & "rd, " & Year(Newdate)
                        JACK_Cell = Newdate
                            With JACK_Cell.Characters(Start:=MonthLength, Length:=2).Font
                                .Superscript = True
                            End With
                    Case 4 To 9 '4th to 9th
                        MonthLength = Len(Format(JACK_Cell, "mmmm")) + 3
                        Newdate = Format(JACK_Cell, "mmmm") & " " & Right(day, 1) & "th, " & Year(Newdate)
                        JACK_Cell = Newdate
                            With JACK_Cell.Characters(Start:=MonthLength, Length:=2).Font
                                .Superscript = True
                            End With
                    Case 10 To 20, 24 To 30 '9th to 30th
                        MonthLength = Len(Format(JACK_Cell, "mmmm")) + 4
                        Newdate = Format(JACK_Cell, "mmmm") & " " & day & "th, " & Year(Newdate)
                        JACK_Cell = Newdate
                            With JACK_Cell.Characters(Start:=MonthLength, Length:=2).Font
                                .Superscript = True
                            End With
                    Case 21 '21st
                        MonthLength = Len(Format(JACK_Cell, "mmmm")) + 4
                        Newdate = Format(JACK_Cell, "mmmm") & " " & day & "st, " & Year(Newdate)
                        JACK_Cell = Newdate
                            With JACK_Cell.Characters(Start:=MonthLength, Length:=2).Font
                                .Superscript = True
                            End With
                    Case 22 '22nd
                        MonthLength = Len(Format(JACK_Cell, "mmmm")) + 4
                        Newdate = Format(JACK_Cell, "mmmm") & " " & day & "nd, " & Year(Newdate)
                        JACK_Cell = Newdate
                            With JACK_Cell.Characters(Start:=MonthLength, Length:=2).Font
                                .Superscript = True
                            End With
                    Case 23 '23rd
                        MonthLength = Len(Format(JACK_Cell, "mmmm")) + 4
                        Newdate = Format(JACK_Cell, "mmmm") & " " & day & "rd, " & Year(Newdate)
                        JACK_Cell = Newdate
                            With JACK_Cell.Characters(Start:=MonthLength, Length:=2).Font
                                .Superscript = True
                            End With
                    Case 31 '31st
                        MonthLength = Len(Format(JACK_Cell, "mmmm")) + 4
                        Newdate = Format(JACK_Cell, "mmmm") & " " & day & "st, " & Year(Newdate)
                        JACK_Cell = Newdate
                            With JACK_Cell.Characters(Start:=MonthLength, Length:=2).Font
                                .Superscript = True
                            End With
            End Select
    End If
Next

End Sub

Enjoy!
Corticus