Sorting Dates using Excel / VBA

Sub StartSorting() 
Dim Array1 As Variant 
Dim Result_Array1 As Variant 

    Array1 = Array("100 Year", "1 Day", "Mar 2010", "10 Mar 2010", "9 Mar 2010", "09 Mar 2010", "2 Day ", "1 Month ", "10 Year ", "9 year", "3 Month ", "Jun 2010") 
         
    Result_Array1 = SortArray(Array1) 
     
    For Each arraymember In Result_Array1 
        Debug.Print arraymember 
    Next 
     
End Sub

Function SortArray(myArray As Variant) As Variant 
Dim currActiveSheet As String 
Dim myTempSortSheet As String 

Dim myNewArray() As Variant 
Dim lCounter As Long 

Dim bDispAlert As Boolean 
Dim bScrUpdate As Boolean 
Dim lRow As Long 

    bDispAlert = Application.DisplayAlerts 
    bScrUpdate = Application.ScreenUpdating 
    currActiveSheet = ActiveSheet.Name 
     
On Error GoTo Err_Handle 

    Application.DisplayAlerts = False 
    Application.ScreenUpdating = False 
     
    ReDim myNewArray(UBound(myArray)) 
     
    myTempSortSheet = "mySortTemp" 

    On Error Resume Next 
        Sheets(myTempSortSheet).Delete 
    On Error GoTo Err_Handle 
         
    Sheets.Add 
    ActiveSheet.Name = myTempSortSheet 
             
    lRow = 1 
    Cells(lRow, 1) = "Array" 
    Cells(lRow, 2) = "Type" 

    For Each arraymember In myArray 
        lRow = lRow + 1 
        Cells(lRow, "A") = arraymember 
    Next 
         
    If (lRow > 1) Then 
         
        With Range("B2:B" & lRow) 
            .FormulaR1C1 = "=myType(RC1)" 
            .Copy 
            .PasteSpecial xlPasteValues 
        End With 
     
        Cells.Select 
         
        Selection.Sort _ 
                Key1:=Range("b2"), Order1:=xlAscending, _ 
                Key2:=Range("A2"), Order2:=xlAscending, _ 
                Header:=xlYes, OrderCustom:=1, _ 
                MatchCase:=False, Orientation:=xlTopToBottom 
        
       lRow = 2 
        
       For lCounter = LBound(myNewArray) To UBound(myNewArray) 
            myNewArray(lCounter) = Cells(lRow, "A") 
            lRow = lRow + 1 
       Next lCounter 
     
    End If 
     
    SortArray = myNewArray 
     
    GoTo End_Sub 
    
Err_Handle: 
    MsgBox ("Error Encountered." & Err.Description) 
     
End_Sub: 
     
    On Error Resume Next 
        Sheets(myTempSortSheet).Delete 
    On Error GoTo 0 
     
    Sheets(currActiveSheet).Select 
    Application.DisplayAlerts = bDispAlert 
    Application.ScreenUpdating = bScrUpdate 
     
End Function 

Function myType(cell As Range) As Variant 
Dim answer As String 

    If (InStr(1, LCase(cell), " day") > 0) Then 
            answer = "001 - " & Right("00000" & Left(cell, InStr(1, LCase(cell), " day") - 1), 5) 
     
    ElseIf (InStr(1, LCase(cell), " month") > 0) Then 
        answer = "002 - " & Right("00000" & Left(cell, InStr(1, LCase(cell), " month") - 1), 5) 
     
    ElseIf (IsDate(cell)) Then 
        answer = "003" 
     
    ElseIf (InStr(1, LCase(cell), " year") > 0) Then 
        answer = "004 - " & Right("00000" & Left(cell, InStr(1, LCase(cell), " year") - 1), 5) 
    Else 
        answer = "005" 
    End If 
     
    myType = answer 
     

End Function