Making Your Own Date Format

[student123]

Let's say I would like to make my own date format.

Theoretically it would check todays date (day and month) and apply a code (for example that I wrote in Java language)

The reason I am doing it so complicated is that I need really specific date format that is not yet available (to my knowledge) in Office insert: "date and time".

Working principle: IF today's is 22nd of October -> then it would write: "October month twenty second day" <- exactly like this.

My quetion is if it's possible to implement this in Excel (or Word) VBA, when I open a document and it would write in a cell (or top of the document)?
MS Version 2013

' Firstly checking number of the month and applying a name for it

'I am using SWITCH function but could also use IF  - as with days below. 

switch (month) {
            case 1:mo = "January"; 
break;
            case 2:
                mo = "February"; 
                break;
            case 3:
                mo = "March";
                break;
'and so on           
 case 4:
                mo = "..";
                break;
            case 5:
                mo = "..";
                break;
            case 6:
                mo = "..";
                break;
            case 7:
                mo = "..";
                break;
            case 8:
                mo = "..";
                break;
            case 9:
                mo = "..";
                break;
            case 10:
                mo = "..";
                break;
            case 11:
                mo = "..";
                break;
            case 12:
                mo = "..";
                break;
            default:

'Now checking day number and applying name to it:
if ((day == 1))
System.out.println(mo + " month" + " first day");
            else if ((day == 2 ))
                System.out.println(mo + " month" + " second day");
            else if ((day == 3 ))
                System.out.println(mo + " month" +" third day");
            else if ((day == 4 ))
                System.out.println(mo + " month" +" fourth day");
            else if ((day == 5 ))
                System.out.println(mo + " month" +" fith day");
          
               
'and so on

' If current date is (DD MM) 03 03,  macro would write : March month third day

[Paul_Hossler]

I'd brute force it like this

Option Explicit

Sub test()
    MsgBox SpecialDateFormat(Now)
    
End Sub
 
Function SpecialDateFormat(Dt As Date)
    SpecialDateFormat = Format(Dt, "mmmm") & " month " & _
    Array("first", "second", "third", "fourth", "fifth", "sixth", "seventh", _
        "eighth", "ninth", "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-ninth", "thirtieth", "thirty-first")(Day(Dt) - 1) & _
        " day"
End Function

[SamT]

That is probably as concise as you'll ever get.

[student123]

Thanks so much!
1) Since I'll use this not in English, could I also control and rename month names?
2) How could I make it work to insert in a specific line (when I open a document)?

Option Explicit
Private Sub Document_OPEN()
MsgBox SpecialDateFormat(Now)
End Sub

Function SpecialDateFormat(Dt As Date)
    SpecialDateFormat = Format(Dt, "mmmm") & " month " & _
    Array("first", "second", "third", "fourth", "fifth", "sixth", "seventh", _
    "eighth", "ninth", "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-ninth", "thirtieth", "thirty-first")(Day(Dt) - 1) & _
    " day"
End Function

[Paul_Hossler]

Since this is the Excel forum, I assumed a workbook. Do you want a MS Word document?

[Paul_Hossler]

I think that the Windows Regional settings (Location in Control Panel) will automatically handle that

I told my PC it was in France and that it was May 7, 2015 (US format)

Option Explicit

 
Sub test()
    MsgBox SpecialDateFormat(DateSerial(2015, 5, 7))
End Sub
 
Function SpecialDateFormat(Dt As Date)
    SpecialDateFormat = Format(Dt, "mmmm") & " month " & _
    Array("first", "second", "third", "fourth", "fifth", "sixth", "seventh", _
    "eighth", "ninth", "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-ninth", "thirtieth", "thirty-first")(Day(Dt) - 1) & _
    " day"
    
End Function

Capture.JPG


Is that OK?

[student123]

I have no idea how to explain this but not really . In my language we have "declensional" nouns and if there is no number to month then it shows wrongly..
For instance:
Correctly it should be ( I shall try in Lithuanian ):
Legend: Sausis is January, menesio - month, septinta - seventh, diena - day. "" means constant word.

Sausio "menesio" 7 "diena" (Sausio with -io at the end: this is correct).

If there is no number to the month as now then it automaticaly writes: (wrong: with - is at the enf.) SausIS "menesio" septinta "diena".

So it would really help if I could edit it (month names )manually.


An example of a Latin noun declension is given below, using the singular forms of the word homo (man), which belongs to Latin's third declension.

• homo (nominative) "[the] man" [as a subject] (e.g., homo ibi stat the man is standing there)
• hominem (accusative) "[the] man" [as a direct object] (e.g., ad hominem toward the man, in the sense of argument directed personally; hominem vidi I saw the man)
• hominis (genitive) "of [the] man" [as a possessor] (e.g., nomen hominis est Claudius the man's name is Claudius)
• hominī (dative) "to [the] man" [as an indirect object] (e.g., homini donum dedi I gave a present to the man; homo homini lupus est Man is a wolf to man.)
• homine (ablative) "[the] man" [in various uses not covered by the above] (e.g., sum altior homine I am taller than the man).

[student123]

Since this is the Excel forum, I assumed a workbook. Do you want a MS Word document?

Actually, I do not really care if it's excel or word I can easily adapt to it.

[Paul_Hossler]

The best I can come up with using the rules as I understand them is this. Maybe you can improve it to better meet your requirements


I Googled the Lithuanian months and changed the-is to -io

Option Explicit
 
 
Sub test()
    MsgBox SpecialDateFormat(DateSerial(2015, 1, 7))
End Sub
 
Function SpecialDateFormat(Dt As Date)
    SpecialDateFormat = _
        Array("Sausio", "Vasaris", "Kovas", "Balandio", "Geguže", "Birželio", _
            "Liepa", "Rugpjutio", "Rugsejio", "Spalio", "Lapkritio", "Gruodio")(Month(Dt) - 1) & _
        " menesio " & _
        Array("first", "second", "third", "fourth", "fifth", "sixth", "septinta", _
        "eighth", "ninth", "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-ninth", "thirtieth", "thirty-first")(Day(Dt) - 1) & _
            " diena"
End Function

[SamT]

Use Multiple Arraysand Constants , two for each language.

Const LithuaniaMonthName As Variant = Array("Sausio", "Vasaris", "Kovas", "Balandio", "Geguže", "Birželio", _ 
    "Liepa", "Rugpjutio", "Rugsejio", "Spalio", "Lapkritio", "Gruodio")

Const LithuaniaMonthWord As String = " menesio "

Const LithauniaDaynumber As Variant = Array("first", "second", "third", "fourth", "fifth", "sixth", "septinta", _ 
    "eighth", "ninth", "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-ninth", "thirtieth", "thirty-first")

Const LithauniaDayWord As String = " diena"

Repeat the above for each language

Then A Select Case

Private Function SetArrays()
SelectCase LocalLanguage
Case "Lithuanian"
MonthNameArray =  LithuaniaMonthName
MonthWord  = LithuaniaMonthWord
DayNumberArray  = LithauniaDaynumber
DayWord = LithauniaDayWord

Case EnglishUSA
MonthNameArray =  USAMonthName
MonthWord  = USAMonthWord
DayNumberArray  = USADaynumber
DayWord = USADayWord
End Select
End Function

Then your Special format code

Function SpecialDateFormat(Dt As Date) 
SetArrays
    SpecialDateFormat = _ 
    MonthNameArray(Month(Dt) - 1) & _ 
    MonthWord & _ 
    DayNumberArray(Day(Dt) - 1) & _ 
    DayWord 
End Function

See how shamelessly I stole Pauls hard work

[student123]

OK. This is already so so good! Thank you very much for your great work Paul and Sam!

One more thing that I encountered and I think it's quite a tricky one (to my surprise how complicated can a date implementation be):

If you'll try to copy Lithuanian letters used in language (ąčęėįšųūž) to VBA like "č" used in month LapkriČio (November) you'll get "c" or some other symbol that I can't copy in here. This problem is also with number names .

The solution to this problem probably would be to use data of the month and day names outside of vba like from txt file saved in UTF-8?

What you guys think?

[SamT]

From the Program manager of the Excel-5 and VBA development team himself: http://www.joelonsoftware.com/articles/Unicode.html

Now you're getting to the point of having separate Modules for each language.

Assign the Unicode Strings to Constants and use the Constants in the Month and DayNumber arrays

Example for Module "Lithuanian"

Private Const Sausio As String  = Uni-S & Uni-a & uni-etc & so forth
Private Const Vasaris As String = Concatenated Unicode Characters

Public Const LithuaniaMonthName As Variant = Array(Sausio, Vasaris, Etc, ) '<-- Constants, not strings, no quote marks

No other code needs to change.

Advantages of separate language Modules:

You know exactly where to edit errors:

If you know that the documents are only each going to use one language, all Language modules can define the same constants IF you also put "Option Private Module" at the top of the Module until you Drag it into a different MS Application's document. In that case, you don't use the Select Case structure.

[student123]

Good article. Could you please specify where should I insert this? Can't make it work.

[Paul_Hossler]

I think the font MS uses for MsgBox doesn't support wide characters, but a textbox on a userform does (see screen shots)

I told the PC it was in Lithuania

The month (and other) strings have to be specially crafted -- I only did November ("Lapkrit" & ChrW(C_caron) & "io") -- but if you do it this way you'll need the wide char values

Also I read the language from the registry to Select Case the right arrays

The xlsm has the userform

Option Explicit
'See http://msdn.microsoft.com/en-us/libr...(v=VS.85).aspx for meaning of various constants.
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, _
    ByVal LCType As Long, _
        ByVal lpLCData As String, _
            ByVal cchData As Long) As Long
            
'https://msdn.microsoft.com/en-us/goglobal/bb964664.aspx
Public Const LOCALE_USER_DEFAULT As Long = &H400
Public Const LOCALE_SABBREVLANGNAME As Long = &H3

Public aMonthNames As Variant
Public MonthWord As String
Public aDayNumbers As Variant
Public DayWord As String
Public Const C_caron As Long = &H10D
 
Sub driver()
    MsgBox SpecialDateFormat(DateSerial(2015, 11, 7))
End Sub
    
Function SpecialDateFormat(Dt As Date)
    SetArrays
    SpecialDateFormat = _
        aMonthNames(Month(Dt) - 1) & _
        " " & MonthWord & _
        " " & aDayNumbers(Day(Dt) - 1) & _
        " " & DayWord
End Function
    
    
'https://en.wikipedia.org/wiki/Lithuanian_orthography
'https://en.wikipedia.org/wiki/Latin_Extended-A
'The majority of the Lithuanian alphabet is in the Unicode block C0 controls and basic Latin (non-accented symbols),
'and the rest of the Lithuanian alphabet (aAcCeEeEiIšŠuUuUžŽ) is in the Latin Extended-A.
Private Function SetArrays()
    Dim sLang As String
    Dim i As Long
    sLang = GetInfo(LOCALE_SABBREVLANGNAME)
    
    Select Case sLang
        Case "LTH"
            aMonthNames = Array("Sausio", "Vasaris", "Kovas", "Balandio", "Geguže", "Birželio", _
                "Liepa", "Rugpjutio", "Rugsejio", "Spalio", "Lapkrit" & ChrW(C_caron) & "io", "Gruodio")
            MonthWord = "menesio"
            aDayNumbers = Array("first", "second", "third", "fourth", "fifth", "sixth", "septinta", _
                "eighth", "ninth", "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-ninth", "thirtieth", "thirty-first")
            DayWord = "diena"
    
        Case "ENU"
            aMonthNames = Array("January", "February", "March", "April", "May", "June", _
                            "July", "Auguet", "September", "October", "November", "December")
            MonthWord = "month"
            aDayNumbers = Array("first", "second", "third", "fourth", "fifth", "sixth", "seventh", _
                "eighth", "ninth", "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-ninth", "thirtieth", "thirty-first")
            DayWord = "day"
    
        Case Else
            MsgBox "Oops"
        End Select
End Function

Private Function GetInfo(ByVal lInfo As Long) As String
    Dim Buffer As String
    Dim ret As String
    Buffer = String$(256, 0)
    ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer, Len(Buffer))
    If ret > 0 Then
        GetInfo = Left$(Buffer, ret - 1)
    Else
        GetInfo = vbNullString
    End If
lbl_Exit:
    Exit Function
End Function

[student123]

Fantastic work! Where could I get the rest of the chrW char letters? I tried ChrW(S_caron) doesn't work like this

[Paul_Hossler]

I only defined the Constant in hex for C_caron

Public Const C_caron As Long = &H10D

The rest are in the link I included:

https://en.wikipedia.org/wiki/Latin_Extended-A

so the others you need would need to be defined the same way using the hex from the link

[snb]

Did you know ?:

=TEXT(TODAY(); "[$-427] mmmm \mo\n\t\h dddd \da\y")

or

Sub M_snb()
  MsgBox Application.Text(Date, "[$-427]mmmm \mo\n\t\h dddd \da\y")
End Sub 

or

Sub M_snb()
  MsgBox Replace(StrConv(Application.Text(Date - 260, "[$-427]mmmm \m\o\n\t\h dddd \da\y"), vbUnicode), Chr(0), "")
End Sub 

and the result of

Sub M_snb()
    MsgBox join(Application.GetCustomListContents(4),vblf)
End Sub 

[SamT]

Here is an Enum you can paste into a standard module named "Unicodes_Latin" and use the constants anywhere in your code as Paul did.

& ChrW(C_caron) & 
ChrW(lcCaron) 'From Enum below

UPDATE: Some errors were found in the Code and the attachment. They have been corrected. If you find more, please Tell me. Many eyes are better than 2

See the Attachment, sheet "Latin" for Character Names

Option Explicit

Enum LatinUnicodes
UAMacron = 256
laMacron = 257
UABreve = 258
laBreve = 259
UAOgonek = 260
laOgonek = 261
UCAcute = 262
lcAcute = 263
UCCircumflex = 264
lcCircumflex = 265
UCDotAbove = 266
lcDotAbove = 267
UCCaron = 268
lcCaron = 269
UDCaron = 270
ldCaron = 271
UDStroke = 272
ldStroke = 273
UEMacron = 274
leMacron = 275
UEBReve = 276
leBReve = 277
UEDotAbove = 278
leDotAbove = 279
UEOganek = 280
leOganek = 281
UECaron = 282
leCaron = 283
UGCircumflex = 284
lgCircumflex = 285
UGBreve = 286
lgBreve = 287
UGDotAbove = 288
lgDotAbove = 289
UGCedilla = 290
lgCedilla = 291
UHCircumflex = 292
lhCircumflex = 293
UHStroke = 294
lhStroke = 295
UITilde = 296
liTilde = 297
UIMacron = 298
liMacron = 299
UIBreve = 300
liBreve = 301
UIOganek = 302
liOganek = 303
UIDotAbove = 304
liDotless = 305
UIJLigature = 306
lijLigature = 307
UJCircumflex = 308
ljCirvumflex = 309
UKCedilla = 310
lkCedilla = 311
lkKra = 312
ULAcute = 313
llAcute = 314
ULCedilla = 315
llCedilla = 316
ULCaron = 317
llCaron = 318
ULMiddleDot = 319
llMiddleDot = 320
ULStroke = 321
llStroke = 322
UNAcute = 323
lnAcute = 324
UNCedilla = 325
lnDedilla = 326
UNCaron = 327
lnCaron = 328
'Deprecated = 329 'See Constant below

'European Latin
UNEngma = 330
lnEngma = 331
UOMacron = 332
loMacron = 333
UOBreve = 334
loBreve = 335
UODblAcute = 336
loDbleAcute = 337
UOELigature = 338
loeLigature = 339
URAcute = 340
lrAcute = 341
URCedilla = 342
lrCedilla = 343
URCaron = 344
lrCaron = 345
USAcute = 346
lsAcute = 347
USCircumflex = 348
lsCircumflex = 349
USCedilla = 350
lsCedilla = 351
USCaron = 352
lsCaron = 353
UTCedilla = 354
ltCedilla = 355
UTCaron = 356
ltCaron = 357
UTStroke = 358
ltStroke = 359
UUTilde = 360
luTilde = 361
UUMacron = 362
luMacrom = 363
UUBreve = 364
luBreve = 365
UURingAbove = 366
luRingAbove = 367
UUDblAcute = 368
luDbleAcute = 369
UUOganex = 370
luOganex = 371
UWCircumflex = 372
lwCircumflex = 373
UYCircumflex = 374
lyCircumflex = 375
UYDiaeresis = 376
UZAcute = 377
lzAcute = 378
UZDotAbove = 379
lzDotAbove = 380
UZCaron = 381
lzCaron = 382
lsLongS = 383
End Enum

'Replaces Deprecated Unicode character 329
Const lnApostrophePrefix As String = "'n"

[Paul_Hossler]

@snb --


1. Slightly simpler

Me.Label1.Caption = Application.Text(DateSerial(2015, 11, 7), "[$-427]mmmm "" menesio "" dddd "" diena""")

2. We tried something very similar, but per #7

In my language we have "declensional" nouns and if there is no number to month then it shows wrongly..

For instance:

Correctly it should be ( I shall try in Lithuanian ):

Legend: Sausis is January, menesio - month, septinta - seventh, diena - day. "" means constant word.

Sausio "menesio" 7 "diena" (Sausio with -io at the end: this is correct).

If there is no number to the month as now then it automaticaly writes: (wrong: with - is at the enf.) SausIS "menesio" septinta "diena".

but without hand tweaking (AFAIK), you don't get the 'io' at the end

[student123]

Finally finished, looks chaotic but it works! Thank you so much for your help! You guys are genius!

The last thing that I would like to do is to implement it in my system: when I open a word document (sorry that this post is for excel I did not know that I am going to use in word) there would be a constant place that this specific date format would be inserted. I believe it is possible?

How should I change the code and specify the place? Or maybe it's possible to assign it to {TIME \@ SpecialDateFormat} with auto update?

The attachment: I can't believe but it works.doc