VB code needed for sorting function - please help!

[monica S]

Hi,

This has been driving me crazy... hopefully someone out there can help.

If I have an ORIGINAL range of dates in cells A1:A5:

22-Apr-04
30-Apr-04
22-May-04
22-Aug-04
22-Sep-04

and a TARGET date of say 16-Jun-04 in cell B1.

I would like to have a FUNCTION that will 'read' the OriginalDates, take the TargetDate into account, and then just INCLUDE or INSERT the target date among this original range of dates. The function would return the new dates in ascending order (i.e. with dates closest to now coming first and dates furthest from now coming last). The function would have to be typed in as an ARRAY function (with the { } bracketing the formula and closing it using Ctrl+Shift+Enter) and would return 1 more row than what is passed through OriginalDates argument.

so, the function would have two arguments and go something like this:

{=IncludeDate(OriginalDates,TargetDate)}

or;

{=(A1:A5,B1)}

In our example, the function would return the following sorted set of dates (with the June 16, 2004 date included and SORTED among the original set of dates):

22-Apr-04
30-Apr-04
22-May-04
*16-Jun-04*
22-Aug-04
22-Sep-04

in cells C1:C6 as a NEW OUTPUT RANGE of dates.

In this case, we would copy our function down 6 rows (one more than the OriginalDates) and close it with the Ctrl+Shift+Enter to make it an ARRAY of 6 rows.

A MACRO WILL NOT HELP IN THIS CASE. ALSO, USING THE DATA --> SORTING FUNCTIONALITY WILL NOT HELP IN THIS CASE. TRUE, BOTH WILL WORK, BUT THIS PROJECT CALLS FOR A **FUNCTION** TO HANDLE THE TASK.

Any ideas on how to go about doing this?

Thank you very much!
~ Monica

 

[NateO]

****, I said I wasn't going to do this, but the above looks a little expensive (although I have not timed any of this out). Here's what I was getting at earlier:<font face=Courier New><SPAN style="color:darkblue">Function</SPAN> Fubar( _
    <SPAN style="color:darkblue">ByVal</SPAN> myRng<SPAN style="color:darkblue">As</SPAN> Range, _
    <SPAN style="color:darkblue">ByVal</SPAN> myItem<SPAN style="color:darkblue">As</SPAN><SPAN style="color:darkblue">Long</SPAN>, _
    <SPAN style="color:darkblue">Optional</SPAN><SPAN style="color:darkblue">ByVal</SPAN> myDtes<SPAN style="color:darkblue">As</SPAN><SPAN style="color:darkblue">String</SPAN>)<SPAN style="color:darkblue">As</SPAN><SPAN style="color:darkblue">Long</SPAN><SPAN style="color:darkblue">Dim</SPAN> myArr<SPAN style="color:darkblue">As</SPAN><SPAN style="color:darkblue">Variant</SPAN>, myCol<SPAN style="color:darkblue">As</SPAN> Collection, i<SPAN style="color:darkblue">As</SPAN><SPAN style="color:darkblue">Long</SPAN>, j<SPAN style="color:darkblue">As</SPAN><SPAN style="color:darkblue">Long</SPAN><SPAN style="color:darkblue">Dim</SPAN> tmpArr<SPAN style="color:darkblue">As</SPAN><SPAN style="color:darkblue">Variant</SPAN>, Swap1<SPAN style="color:darkblue">As</SPAN><SPAN style="color:darkblue">Variant</SPAN>, Swap2<SPAN style="color:darkblue">As</SPAN><SPAN style="color:darkblue">Variant</SPAN><SPAN style="color:darkblue">Let</SPAN> myArr = myRng.Value<SPAN style="color:darkblue">Set</SPAN> myCol =<SPAN style="color:darkblue">New</SPAN> Collection<SPAN style="color:darkblue">If</SPAN><SPAN style="color:darkblue">Not</SPAN> IsArray(myArr)<SPAN style="color:darkblue">Then</SPAN>
   myCol.Add myArr,<SPAN style="color:darkblue">CStr</SPAN>(myArr)
  <SPAN style="color:darkblue">Else</SPAN>
      <SPAN style="color:darkblue">For</SPAN> i =<SPAN style="color:darkblue">LBound</SPAN>(myArr, 1)<SPAN style="color:darkblue">To</SPAN><SPAN style="color:darkblue">UBound</SPAN>(myArr, 1)
          <SPAN style="color:darkblue">On</SPAN><SPAN style="color:darkblue">Error</SPAN><SPAN style="color:darkblue">Resume</SPAN><SPAN style="color:darkblue">Next</SPAN>
           myCol.Add myArr(i, 1),<SPAN style="color:darkblue">CStr</SPAN>(myArr(i, 1))
          <SPAN style="color:darkblue">On</SPAN><SPAN style="color:darkblue">Error</SPAN><SPAN style="color:darkblue">GoTo</SPAN> 0
      <SPAN style="color:darkblue">Next</SPAN><SPAN style="color:darkblue">End</SPAN><SPAN style="color:darkblue">If</SPAN><SPAN style="color:darkblue">If</SPAN><SPAN style="color:darkblue">CBool</SPAN>(Len(myDtes))<SPAN style="color:darkblue">Then</SPAN>
    <SPAN style="color:darkblue">Let</SPAN> tmpArr = Split(myDtes, ",")
    <SPAN style="color:darkblue">If</SPAN><SPAN style="color:darkblue">Not</SPAN> IsArray(tmpArr)<SPAN style="color:darkblue">Then</SPAN>
        <SPAN style="color:darkblue">On</SPAN><SPAN style="color:darkblue">Error</SPAN><SPAN style="color:darkblue">Resume</SPAN><SPAN style="color:darkblue">Next</SPAN>
        myCol.Add<SPAN style="color:darkblue">CDate</SPAN>(tmpArr), tmpArr
        <SPAN style="color:darkblue">On</SPAN><SPAN style="color:darkblue">Error</SPAN><SPAN style="color:darkblue">GoTo</SPAN> 0
        <SPAN style="color:darkblue">Else</SPAN>
            <SPAN style="color:darkblue">For</SPAN> i =<SPAN style="color:darkblue">LBound</SPAN>(tmpArr)<SPAN style="color:darkblue">To</SPAN><SPAN style="color:darkblue">UBound</SPAN>(tmpArr)
                <SPAN style="color:darkblue">On</SPAN><SPAN style="color:darkblue">Error</SPAN><SPAN style="color:darkblue">Resume</SPAN><SPAN style="color:darkblue">Next</SPAN>
                myCol.Add<SPAN style="color:darkblue">CDate</SPAN>(tmpArr(i)), tmpArr(i)
                <SPAN style="color:darkblue">On</SPAN><SPAN style="color:darkblue">Error</SPAN><SPAN style="color:darkblue">GoTo</SPAN> 0
            <SPAN style="color:darkblue">Next</SPAN>
    <SPAN style="color:darkblue">End</SPAN><SPAN style="color:darkblue">If</SPAN><SPAN style="color:darkblue">End</SPAN><SPAN style="color:darkblue">If</SPAN><SPAN style="color:darkblue">For</SPAN> i = 1<SPAN style="color:darkblue">To</SPAN> myCol.Count - 1
    <SPAN style="color:darkblue">For</SPAN> j = i + 1<SPAN style="color:darkblue">To</SPAN> myCol.Count
        <SPAN style="color:darkblue">If</SPAN> myCol(i) > myCol(j)<SPAN style="color:darkblue">Then</SPAN>
            Swap1 = myCol(i)
            Swap2 = myCol(j)
            myCol.Add Swap1, before:=j
            myCol.Add Swap2, before:=i
            myCol.Remove i + 1
            myCol.Remove j + 1
        <SPAN style="color:darkblue">End</SPAN><SPAN style="color:darkblue">If</SPAN>
    <SPAN style="color:darkblue">Next</SPAN> j<SPAN style="color:darkblue">Next</SPAN> i
Fubar = myCol(myItem)<SPAN style="color:darkblue">Set</SPAN> myCol =<SPAN style="color:darkblue">Nothing</SPAN><SPAN style="color:darkblue">End</SPAN><SPAN style="color:darkblue">Function</SPAN></FONT>

Book1
	A	B	C	D
1	22-Apr-04	22-Apr-04
2	30-Apr-04	30-Apr-04
3	30-Apr-04	22-Aug-04
4	22-Aug-04	22-Sep-04
5	22-Sep-04
6	22-Apr-04
Sheet2

Book1
	A	B	C	D
1	22-Apr-04	01-Jan-01
2	30-Apr-04	22-Apr-04
3	30-Apr-04	30-Apr-04
4	22-Aug-04	16-Jun-04
5	22-Sep-04	04-Jul-04
6	22-Apr-04	22-Aug-04
7		22-Sep-04
Sheet2 (2)

Still, I can't be too sure how clever this really is relative to simply sorting and filtering. :wink:

 

[Greg Truby]

OK, Monica, this function should actually meet the spec's of your original request - a formula you can array enter providing just two ranges of dates... I simply shamelessly plagerized the code from Nate's last post, tweaking it to accept two ranges and then added in the hint that Corticus gave us on that other thread I'd referenced in our previous conversation.<font face=Courier New><SPAN style="color:#00007F">Function</SPAN> Fubar2(<SPAN style="color:#00007F">ByVal</SPAN> oldDates<SPAN style="color:#00007F">As</SPAN> Range, _
                <SPAN style="color:#00007F">ByVal</SPAN> newDates<SPAN style="color:#00007F">As</SPAN> Range)<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Variant</SPAN>
                <SPAN style="color:#007F00">' Credit goes to Nate O., & Corticus.  I just took</SPAN><SPAN style="color:#007F00">'    their ideas from various threads and combined them.</SPAN>
                
    <SPAN style="color:#00007F">Dim</SPAN> oldArr<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Variant</SPAN>, newArr<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Variant</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> myCol<SPAN style="color:#00007F">As</SPAN> Collection, i<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN>, j<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> Swap1<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Variant</SPAN>, Swap2<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Variant</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> strFormat<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN>
    
    <SPAN style="color:#00007F">Let</SPAN> oldArr = oldDates.Value
    <SPAN style="color:#00007F">Let</SPAN> newArr = newDates.Value
    <SPAN style="color:#00007F">Set</SPAN> myCol =<SPAN style="color:#00007F">New</SPAN> Collection
    
    <SPAN style="color:#00007F">If</SPAN><SPAN style="color:#00007F">Not</SPAN> IsArray(oldArr)<SPAN style="color:#00007F">Then</SPAN>
       myCol.Add oldArr,<SPAN style="color:#00007F">CStr</SPAN>(oldArr)
    <SPAN style="color:#00007F">Else</SPAN>
        <SPAN style="color:#00007F">For</SPAN> i =<SPAN style="color:#00007F">LBound</SPAN>(oldArr, 1)<SPAN style="color:#00007F">To</SPAN><SPAN style="color:#00007F">UBound</SPAN>(oldArr, 1)
            <SPAN style="color:#00007F">On</SPAN><SPAN style="color:#00007F">Error</SPAN><SPAN style="color:#00007F">Resume</SPAN><SPAN style="color:#00007F">Next</SPAN>
            myCol.Add oldArr(i, 1),<SPAN style="color:#00007F">CStr</SPAN>(oldArr(i, 1))
            <SPAN style="color:#00007F">On</SPAN><SPAN style="color:#00007F">Error</SPAN><SPAN style="color:#00007F">GoTo</SPAN> 0
        <SPAN style="color:#00007F">Next</SPAN>
    <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
    
    <SPAN style="color:#00007F">If</SPAN><SPAN style="color:#00007F">Not</SPAN> IsArray(newArr)<SPAN style="color:#00007F">Then</SPAN>
       myCol.Add newArr,<SPAN style="color:#00007F">CStr</SPAN>(newArr)
    <SPAN style="color:#00007F">Else</SPAN>
        <SPAN style="color:#00007F">For</SPAN> i =<SPAN style="color:#00007F">LBound</SPAN>(newArr, 1)<SPAN style="color:#00007F">To</SPAN><SPAN style="color:#00007F">UBound</SPAN>(newArr, 1)
            <SPAN style="color:#00007F">On</SPAN><SPAN style="color:#00007F">Error</SPAN><SPAN style="color:#00007F">Resume</SPAN><SPAN style="color:#00007F">Next</SPAN>
            myCol.Add newArr(i, 1),<SPAN style="color:#00007F">CStr</SPAN>(newArr(i, 1))
            <SPAN style="color:#00007F">On</SPAN><SPAN style="color:#00007F">Error</SPAN><SPAN style="color:#00007F">GoTo</SPAN> 0
        <SPAN style="color:#00007F">Next</SPAN>
    <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>

    <SPAN style="color:#00007F">For</SPAN> i = 1<SPAN style="color:#00007F">To</SPAN> myCol.Count - 1
        <SPAN style="color:#00007F">For</SPAN> j = i + 1<SPAN style="color:#00007F">To</SPAN> myCol.Count
            <SPAN style="color:#00007F">If</SPAN> myCol(i) > myCol(j)<SPAN style="color:#00007F">Then</SPAN>
                Swap1 = myCol(i)
                Swap2 = myCol(j)
                myCol.Add Swap1, before:=j
                myCol.Add Swap2, before:=i
                myCol.Remove i + 1
                myCol.Remove j + 1
            <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
        <SPAN style="color:#00007F">Next</SPAN> j
    <SPAN style="color:#00007F">Next</SPAN> i
    
    strFormat = oldDates.Cells(1, 1).NumberFormat
    <SPAN style="color:#00007F">ReDim</SPAN> newArr(0<SPAN style="color:#00007F">To</SPAN> myCol.Count - 1)
    <SPAN style="color:#00007F">For</SPAN> i = 0<SPAN style="color:#00007F">To</SPAN> myCol.Count - 1
        newArr(i) = Format(myCol(i + 1), strFormat)
    <SPAN style="color:#00007F">Next</SPAN> i
    
    <SPAN style="color:#00007F">Set</SPAN> myCol =<SPAN style="color:#00007F">Nothing</SPAN>
    Fubar2 = Application.Transpose(newArr)<SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">Function</SPAN></FONT>

Book6
	A	B	C	D
1	Inputs1	Inputs2	Example1	Example2
2	22-Apr-04	15-Mar-04	15-Mar-04	22-Apr-04
3	30-Apr-04	22-Jul-04	22-Apr-04	30-Apr-04
4	22-Aug-04		30-Apr-04	22-Jul-04
5	22-Sep-04		22-Jul-04	22-Aug-04
6	22-Apr-04		22-Aug-04
7			22-Sep-04
Sheet1

 

[NateO]

Nate,

Thank you for your explanation. I have cut and pasted your code into a class module. Then, I've populated cells A1:A5 with dates. What next? Do I have to attach the code to a macro button to get it to work? Or something else? I'm really not familiar with this type of code. How do I actually EXECUTE the code?

Thanks and sorry for the silly question,
~ Monica

Sorry, if you have gotten the code into the module which I described you're going to want, it should work by itself. It's an event procedure, it gets triggered as you enter information into any cell in the worksheet. What is the name of the module that you placed the code in? Where are your dates? Is there a header?

 

[monica S]

Thank you both VERY MUCH for your help (and your patience...)! This is exactly what I needed. It suits the project PERFECTLY!

Thank you again,
~ Monica

 

[monica S]

Greg,

In the Fubar2 function, if one of the NewDates is the same as one of the OldDates, the function produces an array of #VALUE! errors. I'm not sure why it does this.

Do you get the same error? If so, is there a way to tweak the Fubar2 code so that the function can accept a NewDate (or dates) that is the same as one of the OldDates? And, IF one of the NewDates is equal to one of the OldDates, could the output array just show that same date ONCE rather than twice in the sorted output array?

For example, here's how my error is generated:

Old Dates in cells D4:D10 are:

15-Apr-04
15-May-04
15-Jun-04
15-Jul-04
15-Aug-04
15-Sep-04
15-Oct-04

New Date in cell G4 is:

15-Jun-04

The function (as an array) in cells I4:11 produces:

#VALUE!
#VALUE!
#VALUE!
#VALUE!
#VALUE!
#VALUE!
#VALUE!
#VALUE!


Thanks again for your help (and patience!)!
~Mon :wink:

 

[NateO]

Can someone please explain to me why marshaling a variant variable containing an array of x elements per call makes more sense then marshaling a single element or item as a 4-byte long integer per call. Especially when one needs to add extra overhead to do this?

Sorry, I am at a loss. It's interesting, it meets the OP’s original constraints but I'm confused as to how it makes any sense in terms of practical implementation.

I am still of the opinion that if you want to sort a range, sort the range. If you want to filter a range for duplicates, filter the range for duplicates. E.g.,

http://www.mrexcel.com/board2/viewtopic.php?t=86068&start=21

 

[Aladin Akyurek]

....
Old Dates in cells D4:D10 are:

15-Apr-04
15-May-04
15-Jun-04
15-Jul-04
15-Aug-04
15-Sep-04
15-Oct-04

New Date in cell G4 is:

15-Jun-04

The function (as an array) in cells I4:11 produces:

#VALUE!
#VALUE!
#VALUE!
#VALUE!
#VALUE!
#VALUE!
#VALUE!
#VALUE!...

Did you try the proposal I made...

aaInclude&SortNonDups monica S.xls
	D	E	F	G	H	I
3
4	15-Apr-04			15-Jun-04		15-Apr-04
5	15-May-04					15-May-04
6	15-Jun-04					15-Jun-04
7	15-Jul-04					15-Jul-04
8	15-Aug-04					15-Aug-04
9	15-Sep-04					15-Sep-04
10	15-Oct-04					15-Oct-04
11
Sheet1

The formula in I4 is:

=IF(ROW()-ROW($I$4)+1<=SizeSeq,INDEX(Seq,ROW()-ROW($I$4)+1),"")

SizeSeq is defined as referring to:

=COUNT(Seq)

and Seq is defined as referring to:

=UNIQUEVALUES(ARRAYUNION(Sheet1!$D$4:$D$10,Sheet1!$G$4),1)

 

[Greg Truby]

Monica,

My apology. It escaped my notice that there was no On Error Resume Next in the part of the function that adds to the collection and the 2nd input is a single cell. Edit that portion of the function to include an On Error Resume Next; i.e.
...
<font face=Courier New>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> IsArray(newArr) <SPAN style="color:#00007F">Then</SPAN>
       <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
       myCol.Add newArr, <SPAN style="color:#00007F">CStr</SPAN>(newArr)
       <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0
    <SPAN style="color:#00007F">Else</SPAN>
        <SPAN style="color:#00007F">For</SPAN> i = <SPAN style="color:#00007F">LBound</SPAN>(newArr, 1) <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(newArr, 1)</FONT>...

<hr>
Nate,
I'm sure you're right about this being expensive. But the plus side is that you don't have to specify an argument to pull back the specified element. In your examples you're using Row() to provide the element arg, but if you're not at Row 1, then you have to subtract an offset to get to 1 [Row()-Row(cell1) or provide some other handle (like inserting a column with the element counter or something) to get the proper element number. While less efficient than what you propose, this does have the advantage of being easier to use (at least to me...).

 

[monica S]

Hi Greg,

This is great. Thank you! One last question:

When I have my OldDates in cells B2:B6 as:

15-Apr-04
15-May-04
15-Jun-04
15-Jul-04
15-Aug-04

and my NewDate in cell C2 as:

15-May-04

and my output range as an array formula in cells D2:D7 (one more row than the number of rows in the OldDates argument),

I get this as the output:

15-Apr-04
15-May-04
15-Jun-04
15-Jul-04
15-Aug-04
#N/A

It seems like I can only get a "clean" output array if the NewDate is not equal to any of the OldDates.

I tried to use the following array formula (copied down in cells D2:D7)to "clean it up":

{=IF(ISNA(Fubar2(B3:B6,C3)),"",Fubar2($B$3:$B$6,$C$3))}

but this solution does not seem to work.

Do you have any ideas how to exclude that #N/A from the output array, either within the function's code or some other way?

Thanks again,
~ Monica

 

[NateO]

Fair enough Greg,

Efficiency doesn't seem matter here anyway, and if we're going to do this in a non dynamic, innefficient manner, we might as well go all out and make it really inefficient. I mean row()-x, who can be bothered with such a dreadful calculation?

I might also recommend double calculating with an iserror() function, and see if we can bring this to a screeching halt. Can we volatility too?

Also, and at the risk of going against popular thinking here, what happens if you don't transpose the marshaled array? Although transposing should slow down the function nicely, we may want to do it several times in fact.

I'm obviously being sarcastic, I still find it interesting, but I just wouldn't do this in this manner with my work. I probably should not have posted fubar(). :wink: