Function DateToWords(ByVal DateIn As Variant) As String Dim Yrs As String Dim Hundreds As String Dim Decades As String Dim Tens As Variant Dim Ordinal As Variant Dim Cardinal As Variant Ordinal = Array("First", "Second", "Third", _ "Fourth", "Fifth", "Sixth", _ "Seventh", "Eighth", "Nineth", _ "Tenth", "Eleventh", "Twelfth", _ "Thirteenth", "Fourteenth", _ "Fifteenth", "Sixteenth", _ "Seventeenth", "Eighteenth", _ "Nineteenth", "Twentieth", _ "Twenty-first", "Twenty-second", _ "Twenty-third", "Twenty-fourth", _ "Twenty-fifth", "Twenty-sixth", _ "Twenty-seventh", "Twenty-eighth", _ "Twenty-nineth", "Thirtieth", _ "Thirty-first") Cardinal = Array("", "One", "Two", "Three", "Four", _ "Five", "Six", "Seven", "Eight", "Nine", _ "Ten", "Eleven", "Twelve", "Thirteen", _ "Fourteen", "Fifteen", "Sixteen", _ "Seventeen", "Eighteen", "Nineteen") Tens = Array("Twenty", "Thirty", "Forty", "Fifty", _ "Sixty", "Seventy", "Eighty", "Ninety") DateIn = CDate(DateIn) Yrs = CStr(Year(DateIn)) Decades = Mid$(Yrs, 3) If CInt(Decades) < 20 Then Decades = Cardinal(CInt(Decades)) Else Decades = Tens(CInt(Left$(Decades, 1)) - 2) & "-" & _ Cardinal(CInt(Right$(Decades, 1))) End If Hundreds = Mid$(Yrs, 2, 1) If CInt(Hundreds) Then Hundreds = Cardinal(CInt(Hundreds)) & " Hundred " Else Hundreds = "" End If DateToWords = Ordinal(Day(DateIn) - 1) & _ Format$(DateIn, " mmmm ") & _ Cardinal(CInt(Left$(Yrs, 1))) & _ " Thousand " & Hundreds & Decades End Function