Sorting Dates using Excel / VBA

Closed
kuldeps - May 9, 2010 at 06:19 AM
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
- May 9, 2010 at 04:52 PM


Hello All,

Just wondering if you can help me in writing VBA sorting logic for Date in asc or dsc order.

Want to sort dates which are not in simple date format (DD/MMM/YYY).

Want to sort dates from Array1 below resulting Results_Array1

Array1
100 Year
1 Day
Mar 2010
2 Day
1 Month
10 Year
3 Moth
Jun 2010


Result_Array1
1 Day
2 Day
1 Month
3 Month
Mar 2010
Jun 2010
10 Year

Thanks for your help in advance.

5 replies

rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
May 9, 2010 at 04:52 PM
I have tested it with 2007 AND OFFICE 97. It should work in between too.


=============================================
THIS IS HOW I TESTED
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



======================================================

CODE:

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 
1
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
May 9, 2010 at 09:22 AM
Can this sort occur with the help of a temp sheet ?
0
Hi Rizvisa1,

Yes, as long at I hav result array.. Temp sheet shouldnt matter.

Regards
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
May 9, 2010 at 09:42 AM
what version of excel are we talking about here?
0

Didn't find the answer you are looking for?

Ask a question
Hi ,

I am using Excel 2002.

Regards,
0