Macro to identify 3-digit and 4-digit numbers as valid dates

[GoJakie]

Hello friends,

I want to convert 3-digit and 4-digit numbers as proper valid dates in the following format
3 digits
d-mmm-yyyy
d-mmm
dd-mmm

4 digits
d-mmm-yyyy
dd-mmm-yyyy
dd-mmm

For example:
* If Cell A1 has 111 -> corresponding cells should have 1-jan-1991, 1-jan-2001, 11-Jan, 1-Nov (that is d-mmm-yyyy, d-mmm-yyyy, d-mmm, dd-mmm)
* If Cell A1 has 1111 -> corresponding cells should have 1-Nov-2001, 1-Nov-1901, 11-Jan-2001, 11-Jan-1901, 1-Jan-2011, 1-Jan-1911, 11-Nov (that is d-mmm-yyyy, d-mmm-yyyy, dd-mmm-yyyy, dd-mmm-yyyy, d-mmm-yyyy, d-mmm-yyyy, dd-mmm)
* If cell A1 has 456 -> corresponding cells should have 4-May-1906, 4-May-2006 (that is d-mmm-yyyy, d-mmm-yyyy)
* If Cell A1 has 3239 -> corresponding cells should have 3-Feb-1939, 3-Feb-2039 (that is d-mmm-yyyy, d-mmm-yyyy)

If a particular 3-digit and 4-digit number does not convert into a proper valid date, the corresponding cell should remain blank. Year should be 20th and 21st centure (1900-1999 or 2000-2099)

I am struggling since past couple of days and I tried splitting numbers, putting filters, concatenate formulas etc but I am not able to set all conditions. I thought macro based solution or a user defined function would be better but I am unable to write it and need help. Appreciate if I can get some start here...

Thank you.

crosspost here : Macro to identify 3-digit and 4-digit numbers as valid dates

 

[Snakehips]

GoJakie,

Here is some code that arguably makes a decent stab at the three digit numbers?
Issues as I see it..... The d-mmm formats appear to attract the year 2015 to their root serial date even if I include 2000 in the code, so I have omitted a year.
Doesn't accommodate Feb 29th for leap years.

But maybe it gives you ideas as to how you may proceed.

Excel Workbook
	A	B	C	D	E
1	Number	Dates..
2	111	01-Jan-1901	01-Jan-2001	01-Nov	11-Jan
3	123	01-Feb-1903	01-Feb-2003	12-Mar
4	456	04-May-1906	04-May-2006
5	282	02-Aug-1902	02-Aug-2002	28-Feb
6	292	02-Sep-1902	02-Sep-2002
Sheet1

Sub DateOrNot()


lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A2:A" & lr)
For Each cell In Rng
    If Len(cell.Value) = 3 Then
        ReDim Ar(1 To 3)
        For c = 1 To 3
            Ar(c) = Mid$(cell.Value, c, 1)
        Next c
        c = 0
        
        c = c + 1
        cell.Offset(0, c) = Format(CDate(Ar(1) & "/" & Ar(2) & "/" & 1900 + Ar(3)), "d-mmmm-yyyy")
        c = c + 1
        cell.Offset(0, c) = Format(CDate(Ar(1) & "/" & Ar(2) & "/" & 2000 + Ar(3)), "d-mmmm-yyyy")
        c = c + 1
        
        Select Case (Ar(2) * 10) + Ar(3)
            Case Is < 13
            cell.Offset(0, c) = Format(CDate(Ar(1) & "/" & (Ar(2) * 10) + Ar(3) & "/1900"), "d-mmm")
            c = c + 1
            Case Else
        End Select
       On Error Resume Next
        Select Case Ar(3)
            Case 1, 3, 5, 7, 8
                If (Ar(1) * 10) + Ar(2) < 32 Then
                    cell.Offset(0, c) = Format(CDate((Ar(1) * 10) + Ar(2) & "/" & Ar(3)), "d-mmm")
                    c = c + 1
                End If
            Case 4, 6, 9
                If (Ar(1) * 10) + Ar(2) < 31 Then
                    cell.Offset(0, c) = Format(CDate((Ar(1) * 10) + Ar(2) & "/" & Ar(3)), "d-mmm")
                    c = c + 1
                End If
            Case 2
                If (Ar(1) * 10) + Ar(2) < 29 Then  ' doesn't recognise leap years!!!!
                    cell.Offset(0, c) = Format(CDate((Ar(1) * 10) + Ar(2) & "/" & Ar(3)), "d-mmm")
                    c = c + 1
                End If
            Case Else
        End Select
        On Error GoTo 0
    End If
Next cell
End Sub

Similar logic can be used to manipulate the four digit numbers but similar shortcomings.

Hope that helps.

 

[AlphaFrog]

Here's my go at it.

It coerces 3 and 4 digits values and the leap day for 292 (column D)

Excel Workbook
	A	B	C	D	E
1	Number	d-m-190y or d-m-19yy	d-m-200y or d-m-20yy	dd-m or dd-mm	d-mm
2	1100	1-Jan-1900	1-Jan-2000
3	123	1-Feb-1903	1-Feb-2003	12-Mar
4	456	4-May-1906	4-May-2006
5	282	2-Aug-1902	2-Aug-2002	28-Feb
6	292	2-Sep-1902	2-Sep-2002	29-Feb
7	3239	3-Feb-1939	3-Feb-2039
8	100
9	101			10-Jan	1-Jan
10	110	1-Jan-1900	1-Jan-2000		1-Oct
11	1000
12	1001			10-Jan
13	1100	1-Jan-1900	1-Jan-2000
14	999	9-Sep-1909	9-Sep-2009
15	9999	9-Sep-1999	9-Sep-2099
Sheet

[color=darkblue]Sub[/color] Coerce_Dates()
    
    [color=darkblue]Dim[/color] Digit(1 [color=darkblue]To[/color] 4) [color=darkblue]As[/color] [color=darkblue]Integer[/color], d(1 [color=darkblue]To[/color] 4) [color=darkblue]As[/color] [color=darkblue]Variant[/color], cell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Integer[/color], v [color=darkblue]As[/color] [color=darkblue]Variant[/color], n [color=darkblue]As[/color] [color=darkblue]Integer[/color], r [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=green]'Headers & column format[/color]
    Range("B1").Value = "d-m-190y or  " & vbLf & "d-m-19yy"
    Range("C1").Value = "d-m-200y or  " & vbLf & "d-m-20yy"
    Range("D1").Value = "dd-m  or " & vbLf & "dd-mm"
    Range("E1").Value = "d-mm"
    Range("B1:E1").WrapText = [color=darkblue]True[/color]
    Columns("B:C").NumberFormat = "d-mmm-yyyy"
    Columns("D:E").NumberFormat = "@"
    
    [color=green]'Coerce dates from values[/color]
    [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] Range("A2", Range("A" & Rows.Count).End(xlUp))
        v = cell.Value: r = cell.Row
        n = Len(v)
        
        [color=darkblue]If[/color] (n = 3 [color=darkblue]Or[/color] n = 4) And IsNumeric(v) [color=darkblue]Then[/color]
            Erase Digit: Erase d: j = 1
            [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] n
                Digit(i) = Mid(v, i, 1)
            [color=darkblue]Next[/color] i
            
            [color=darkblue]If[/color] n = 3 [color=darkblue]Then[/color]
                d(1) = DateSerial(1900 + Digit(3), Digit(2), Digit(1))
                [color=darkblue]If[/color] Day(d(1)) <> Digit(1) [color=darkblue]Or[/color] Month(d(1)) <> Digit(2) [color=darkblue]Then[/color] d(1) = ""
                d(1) = Format(d(1), "d-mmm-yyyy") [color=green]'convert to text to bypass the known 1900 leap year error[/color]
                
                d(2) = DateSerial(2000 + Digit(3), Digit(2), Digit(1))
                [color=darkblue]If[/color] Day(d(2)) <> Digit(1) [color=darkblue]Or[/color] Month(d(2)) <> Digit(2) [color=darkblue]Then[/color] d(2) = ""
                
                d(3) = DateSerial(2012, Digit(3), Digit(1) & Digit(2))      [color=green]'Leap year[/color]
                [color=darkblue]If[/color] Day(d(3)) <> [color=darkblue]CInt[/color](Digit(1) & Digit(2)) [color=darkblue]Or[/color] Month(d(3)) <> Digit(3) [color=darkblue]Then[/color] d(3) = ""
                d(3) = Format(d(3), "'d-mmm")
                
                d(4) = DateSerial(Year(Date), Digit(2) & Digit(3), Digit(1))    [color=green]'Current year[/color]
                [color=darkblue]If[/color] Day(d(4)) <> Digit(1) [color=darkblue]Or[/color] Month(d(4)) <> [color=darkblue]CInt[/color](Digit(2) & Digit(3)) [color=darkblue]Then[/color] d(4) = ""
                d(4) = Format(d(4), "'d-mmm")
                
            [color=darkblue]Else[/color]
                d(1) = DateSerial(1900 + (Digit(3) & Digit(4)), Digit(2), Digit(1))
                [color=darkblue]If[/color] Day(d(1)) <> Digit(1) [color=darkblue]Or[/color] Month(d(1)) <> Digit(2) [color=darkblue]Then[/color] d(1) = ""
                d(1) = Format(d(1), "d-mmm-yyyy") [color=green]'convert to text to bypass the known 1900 leap year error[/color]
                
                d(2) = DateSerial(2000 + (Digit(3) & Digit(4)), Digit(2), Digit(1))
                [color=darkblue]If[/color] Day(d(2)) <> Digit(1) [color=darkblue]Or[/color] Month(d(2)) <> Digit(2) [color=darkblue]Then[/color] d(2) = ""
                
                d(3) = DateSerial(Year(Date), Digit(3) & Digit(4), Digit(1) & Digit(2))   [color=green]'Current year[/color]
                [color=darkblue]If[/color] Day(d(3)) <> [color=darkblue]CInt[/color](Digit(1) & Digit(2)) [color=darkblue]Or[/color] Month(d(3)) <> [color=darkblue]CInt[/color](Digit(3) & Digit(4)) [color=darkblue]Then[/color] d(3) = ""
                d(3) = Format(d(3), "'d-mmm")
                
            [color=darkblue]End[/color] [color=darkblue]If[/color]
            
            [color=green]'Output[/color]
            Rows(cell.Row).Range("B1:E1") = d
            
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] cell
    
    [color=green]'Columns("B:E").AutoFit[/color]
    Columns("B:E").ColumnWidth = 12
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]