Sorting of Date!! 1

[kuldeps]

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 Result_Array1

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


Thanks for your help in advance.

 

[SkipVought]

Hi,

Dates are just NUMBERS. faq68-5827

1/1/1900 is 1. Today is 40306.

That is how sorting is accomplished.

So ANYTHING that you have that is NOT a real date (every singel value as I see it), must be converted to an appropriate number.

I'd suggest using the DATE function and feeding the appropriate YEAR, and/or MONTH and/or DAY.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[kuldeps]

Hi Skip,

Thanks for the reply, tried with dates function, however not been able to display them in sorted order as 1 D, 2 D, Mar 10, etc...


Regards,
Kuldeps

 

[SkipVought]

Post what you tried.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[dhookom]

I don't know how anything meaningfull can be pulled from the values since two of them seem to be a particular point in time Jun 2010 and Mar 2010 while all the remaining values seem relative to some other point in time.

Duane
Hook'D on Access
MS Access MVP

 

[kuldeps]

Please check below function , I am passing Array1 as Range.


Public Function Asort(rng As Range) As Range

On Error GoTo ErrHandler

Dim aArray
Dim R As Range
Dim iVal3
Dim icount As Long
Dim iTemCount As Long
Dim iArrCount As Long
iArrCount = rng.Count
Dim aTempArray() As Integer
aArray = rng
For icount = 1 To iArrCount
For iTemCount = icount + 1 To iArrCount
If (Trim(aArray(iTemCount, 1))) <> "" Then
If (Trim(aArray(icount, 1))) < (Trim(aArray(iTemCount, 1))) Then
iVal3 = Trim((aArray(icount, 1)))
aArray(icount, 1) = aArray(iTemCount, 1)
aArray(iTemCount, 1) = iVal3

End If
End If
Next iTemCount
Next icount
Set R = Range("A1").Resize()


' rng.Sort Key1:=rng, Order1:=xlAscending
' load the worksheet values back into the array
For icount = 1 To R.Rows.Count
ReDim Preserve aTempArray(icount)
aTempArray(icount) = aArray(icount, 1)
Next icount

ActiveSheet.Range("B1:B" & UBound(aTempArray)) = WorksheetFunction.Transpose(aTempArray)

R.Sort Key1:=R, Order1:=xlAscending
R = (aArray)
Asort = aArray

Exit Function
ErrHandler:
Debug.Print Err.Description
Resume Next
End Function

 

[Gavona]

You have not responded to dhookom's point.
What is the logic by which "10 year" is greater than "Jun 2010"? What date is equal to 10 year? What date is equal to "1 day"?

Once we have understood the logic, I suspect it would be more efficient to load your array into worksheet cells and then use the inbuilt sort function (with VBA).

Gavin

 

[kuldeps]

Gavin,

Ok,

1 Day could be from today (T) , 2 Day ( T+1), 3 Day (T+3),... etc...

Similarly we can may have 1 Month ( T+Month) , 2 Month ( T+ Month) and so on....

Also, same can be future points rolling every three months...

Mar10, Jun10, Sep10, Dec10, Mar11, Jun11, Sep11, so on....

similarly 1 year ( T+ 1 year) , 10 year (T+10 year), etc...

So the un - sorted array could be


2 Day
1 Day
3 Month
2 Month
1 Month
Jun11
Mar10
Sep10
Dec10
Mar11
10 Year
1 Year
2 Year
3 Year
70 year
100 year...

Expecting Sorted Array

1 Day
2 Day
1 Month
2 Month
3 Month
Mar 2010
Jun 2010
Sep 2010
Dec 2010
Mar 2011
Jun 2011
Sep 2011
Dec 2011
1 Year
2 Year
3 Year
10 Year
30 Year
40 Year
70 Year
100 Year

Thanks for ur time!!

 

[SkipVought]

1. make a NAMED RANGE table of months
[tt]
Mons
Jan
Feb
Mar
Apr
May
Jun
Jul
Aug
Sep
Oct
Nov
Dec
[/tt]

2. the formula
[tt]
=DATE(IF(ISNUMBER(B2),B2,IF(B2="Year",A2+YEAR(NOW()),0)+1900),IF(B2="Month",A2+1,IF(NOT(ISNA(MATCH(A2,Mons,0))),MATCH(A2,Mons,0),1)),IF(B2="Day",A2,0)+1)
[/tt]


Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[kuldeps]

Cool!! Thanks a lot... Let me try this in VBA , will give u an update once I am done.


Regards,
Kuldeep

 

[kuldeps]

Hi Skip,

Trying to understanding logic here for sorting...


=DATE(IF(ISNUMBER(B2),B2,IF(B2="Year",A2+YEAR(NOW()),0)+1900),IF(B2="Month",A2+1,IF(NOT(ISNA(MATCH(A2,Mons,0))),MATCH(A2,Mons,0),1)),IF(B2="Day",A2,0)+1)0

B2 assuming this is Date range to be sorted (i,e 1 Day), in which case this is always not number and tries to compare with year / Month / Day or Mon range.. which will never be true...

 

[SkipVought]

Sorry, forgot one important step.

First use Data > Text to columns -- DELIMITED on your Array in column A, to divide it into TWO columns DELIMTED on SPACE.

You will have THREE columns, the third being the formula. Sort on the formula column.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[JTBorton]

kuldeps,

If you are interested in learning more about sorting, this may be a good time to point you to a heap sort. There are many sorting algorithms available, but heap sorts are, to my knowledge, the fastest and most efficient sorting method. Understanding the logic and theory will take a little more work than other sorting methods, but it well worth it to learn. I used to have a link to a java animation from the University of Hawaii computer science department that explained heap sorts really, really well, but the link doesn't seem to exist anymore. Here is another useful place to start:

http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/heap/heapen.htm

Much of the code you will find will be in C++ or java, so you have have to try and interpret it (which is also a good exercise). If you wish, I can give you some code that I have translated into VBA.

-JTBorton
Well, You can try banging your head against the wall, but you just end up with lost-time injuries and damaged equipment. [M. Passman]

 

[kuldeps]

JTBorton ,

Thanks a lot for the useful link sent.. I managed to write a logic for sorting with the help of our experts here.. do u think heapsort algorithm can be used to sort alphanumerics?

If you could post ur converted code that would be great.

Also, what would be the iterations / time taken for sorting any array using heapsort?


Regards,

 

[strongm]

>heap sorts are, to my knowledge, the fastest and most efficient sorting method

Well, frankly that depends.

 

[JTBorton]

strongm,

You are quite correct. Like I said, "to my knowledge." But for our intents and purposes, as far as I have read and studied, I would say a heap sort would more than suffice. But what was on your mind? I'm always interested in learning more.


kuldeps,

Sure you can. Just convert the alphanumeric to it's ascii value and compare the numbers. This may take a few more steps in logic since the ascii numbers for each character may not be in the order you prefer. You can is case statements to determine the range:

Select Case Asc(Letter)
    Case 31 To 40
        blah blah blah
    Case 41 To 50
        blah blah blah    
    case Else
        blah blah blah
End Select

Nothing special about 31 to 40 or 41 to 50, I'm just using them as an example. However, it is very important that you spell "blah blah blah" correctly.

The sorting time is given in Big O Notation as O(n log), which is very good.

I'd be glad to post the code, but you'll have to give me some time find where I saved it. I might not be able to post it until tomorrow.

-JTBorton
Well, You can try banging your head against the wall, but you just end up with lost-time injuries and damaged equipment. [M. Passman]

 

[JTBorton]

strongm,

You are quite correct. Like I said, "to my knowledge." But for our intents and purposes, as far as I have read and studied, I would say a heap sort would more than suffice. But what was on your mind? I'm always interested in learning more.


kuldeps,

Sure you can. Just convert the alphanumeric to it's ascii value and compare the numbers. This may take a few more steps in logic since the ascii numbers for each character may not be in the order you prefer. You can use case statements to determine the range. For example,

Select Case Asc(Letter)
    Case 31 To 40
        blah blah blah
    Case 41 To 50
        blah blah blah    
    case Else
        blah blah blah
End Select

Nothing special about 31 to 40 or 41 to 50, I'm just using them as an example. However, it is very important that you spell "blah blah blah" correctly. Since you were sorting months above, I would assign each month a number and sort by that.

The sorting efficiency is given in Big O Notation as O(n log), which is very good. I don't fully understand this notation myself, I just know it's pretty stinkin' good.

I'd be glad to post the code, but you'll have to give me some time find where I saved it. I might not be able to post it until tomorrow.

-JTBorton
Well, You can try banging your head against the wall, but you just end up with lost-time injuries and damaged equipment. [M. Passman]

 

[JTBorton]

Well that's odd. I don't know why it posted twice. Disregard the first one, as I was still editing it. Sorry everyone.

-JTBorton
Well, You can try banging your head against the wall, but you just end up with lost-time injuries and damaged equipment. [M. Passman]

 

[kuldeps]

JTBorton / strongm thanks for the response!!

yes Big O notations reminds me one of the tech interview which I had attended sometime back.. I that I was asked about the fastest algorithm for searching and sorting.. and I had blindly told them heap sort and was not sure about the searching algorithm. Also, which is the best container to be used for sorting or searching.. Ofcourse using Array is not a good idea.

Since we have come to this topic, was wondering if you can through some light on this and swell as Big O notations to understand correctly? I tried goggling the same but couldn’t understand correctly.

Please ignore me if my question is irreverent to this thread.


Regards,

 

[JTBorton]

kuldeps, here are the heap sort functions I promised. I take no credit for these functions. As I mentioned before I translated them from C++ from a university website. I had only just begun to modify them to fit my needs when I got assigned some new projects and had to put it on the shelf. I modified it to accept a base 1 or base 0 array, and was in the process of modifying it to sort alphanumerics. As I said, this can be done by using the Asc() function to convert letters to numbers. Remember that in a Heap sort, nodes on the same level (adjacent) do not have to be in any order. Each node only sees and is concerned with the numbers that branch below them. Once organized, the top number is "popped" and set aside and the heap is resorted. The next largest number is then at the top of the heap. The heap is a gain popped and the process continues until the numbers are in descending order, or ascending order if you prefer to set it that way.

The following function is called to test the heap sort by sorting random numbers placed in cells A1:A200.

Public Sub TestHeap()

Dim RStart As Integer
Dim REnd As Integer
Dim K As Integer
Dim NumArray()

    RStart = 1
    REnd = 200
    ReDim NumArray(1 To REnd)
    For K = RStart To REnd
        NumArray(K) = Val(ActiveSheet.Cells(K, 1))
    Next K
    
    NumArray = HeapSort(NumArray)
    
    For K = RStart To REnd
        ActiveSheet.Cells(K, 1) = NumArray(K)
    Next K
    
End Sub

The HeapSort function is called to begin the process. It first creates the heap, then sorts it.

Option Explicit

Public Function HeapSort(ByRef vntHeap())
    
Dim intLBound As Integer
Dim intHeapSize As Integer

    On Error Resume Next
    intHeapSize = UBound(vntHeap)
    On Error GoTo 0
    If intHeapSize = 0 Then: Exit Function
    intLBound = LBound(vntHeap)
    
    Call MakeHeap(vntHeap:=vntHeap, intHeapSize:=intHeapSize, intLBound:=intLBound)
    Call SortHeap(vntHeap:=vntHeap, intHeapSize:=intHeapSize, intLBound:=intLBound)
    
    HeapSort = vntHeap
    
End Function

Private Sub MakeHeap(ByRef vntHeap(), ByVal intHeapSize As Integer, ByVal intLBound As Integer)

Dim intCount As Integer
    
    'For a given array of base 0, the leaves of the heap will be
    
    For intCount = intHeapSize To intLBound Step -1
        'Create the heap, starting from the end of the array and working towards the begining
        Call SiftHeap(vntHeap:=vntHeap, intHeapSize:=intHeapSize, intLBound:=intLBound, intNode:=intCount)
    Next intCount
    
End Sub

SiftHeap is used to organize each node. It is called both when creating the heap and when sorting the heap.

Private Sub SiftHeap(ByRef vntHeap(), ByVal intHeapSize As Integer, intLBound As Integer, ByVal intNode As Integer)

Dim I           As Integer 'The index of the node being analyzed
Dim J           As Integer 'The index of the largest value between parent and children
Dim intBase1    As Integer 'Correction factor to reach Child 1 of a given parent node
Dim intBase2    As Integer 'Correction factor to reach Child 2 of a given parent node
    
    'For an array of base 0:
    'With a given parent node, i, its two children will be located at 2i+1 and 2i+2 down the array.
    
    'For an array of base 1:
    'With a given parent node, i, its two children will be located at 2i and 2i+1 down the array.
    
    intBase1 = IIf(intLBound = 0, 1, 0)
    intBase2 = IIf(intLBound = 0, 2, 1)
    
    J = intNode
    Do
        I = J 'Set I and J equal, since ideally the node should be the largest value
        
        'Check the first child
        If (2 * I + intBase1) <= intHeapSize Then 'If the child index is within the range of the array
            'If the child is larger than the parent set J to the new index
            If vntHeap(2 * I + intBase1) > vntHeap(J) Then
                J = 2 * I + intBase1
            End If
        End If
        
        'Check the second child
        If (2 * I + intBase2) <= intHeapSize Then 'If the child index is within the range of the array
            'If the child is larger than the parent set J to the new index
            If vntHeap(2 * I + intBase2) > vntHeap(J) Then
                J = 2 * I + intBase2
            End If
        End If
        
        'Swap the values if the parent node is not the largest
        If Not I = J Then
            Call SwapHeap(vntHeap, I, J)
        End If
        
    Loop Until (I = J)

End Sub

The SortHeap function manages the actual sorting of the heap. It calls the SiftHeap function and the SwapHeap function.

Private Sub SortHeap(ByRef vntHeap(), ByVal intHeapSize As Integer, ByVal intLBound As Integer)

Dim intCount As Integer
Dim intRange As Integer
    
    intRange = intHeapSize
    For intCount = intHeapSize To intLBound Step -1
        Call SwapHeap(vntHeap:=vntHeap, I:=intLBound, J:=intCount)
        intRange = intRange - 1
        Call SiftHeap(vntHeap:=vntHeap, intHeapSize:=intRange, intLBound:=intLBound, intNode:=intLBound)
    Next intCount

End Sub

The SwapHeap function swaps items in the array.

Private Sub SwapHeap(ByRef vntHeap(), ByVal I As Integer, ByVal J As Integer)

Dim vntCatch As Variant
    
    vntCatch = vntHeap(I)
    vntHeap(I) = vntHeap(J)
    vntHeap(J) = vntCatch

End Sub

-JTBorton
Well, You can try banging your head against the wall, but you just end up with lost-time injuries and damaged equipment. [M. Passman]