Rearranging Dated data

[asylum]

Hi,

I have written a workbook which I can input a set of fixed date data for a number of different events (such as carrot order, 1st friday june, 2nd sat September ext), which along with an input month and year produces the correct date for each event, so I get a sheet that look like:

Jan Feb Mar etc
Order Carrots 10/02/11
Wash Tates 01/01/11 21/03/11
Pull Leeks 12/01/11 10/02/11


However I would like this to populate a sheet where I have a list of dates in column A (eg from 01/01/11 to 31/03/11) so that against each date is a list of events that should happen on that date, e.g:

01/01/11 Wash Tates
...
12/01/11 Pull Leeks
....
10/02/11 Order Carrots, Pull Leeks
.....
21/03/11 Wash Tates


etc etc

any good thoughts for this? via either formula referingto the main sheet, or by VB?

Cheers

Andy

 

[MickG]

Try this:-
Column of dates in Sheet (1) Column "A".
Veg and dates in Sheet(2) column "A" for Vegetables Offset Columns for dates, Both Veg and dates start row (2)

[COLOR="Navy"]Sub[/COLOR] MG22Feb30
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] DtRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dt [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").CurrentRegion
    [COLOR="Navy"]Set[/COLOR] DtRng = .Offset(1, 1).Resize(.rows.Count - 1, .Columns.Count - 1)
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
    ReDim Ray(1 To Rng.Count, 1 To Columns.Count)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            n = n + 1
            .Add Dn.value, Array(n, 1)
                [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dt [COLOR="Navy"]In[/COLOR] DtRng
                    [COLOR="Navy"]If[/COLOR] Dt = Dn [COLOR="Navy"]Then[/COLOR]
                         Q = .Item(Dn.value)
                         Ray(Q(0), Q(1)) = Range("A" & Dt.row)
                         Q(1) = Q(1) + 1
                         .Item(Dn.value) = Q
                    oMax = Application.Max(Q(1), oMax)
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] Dt
        [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
.Range("B1").Resize(Rng.Count, oMax) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[asylum]

HI,

Thanks For that, unfortunatley it fails at

Set DtRng = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)

With an "application-defined or object-defined error"

just as an aside, in my data the date range starts on cell c8, I know thats not the problem here, but would i need to change this line to read:

Set DtRng = .Offset(7, 2).Resize(.Rows.Count - 7, .Columns.Count - 2)

(as well as also needing to solve the above error)

Tahnsk

Andy

 

[MickG]

If your data looks something like this (see position of cell "C8"):-
Then try the code below
NB:- The code clears data, 10 columns to the right of column (1) on sheet (1), before adding new data.

[COLOR=royalblue][B]Row No [/B][/COLOR][COLOR=royalblue][B]Col(A) [/B][/COLOR][COLOR=royalblue][B]Col(B) [/B][/COLOR][COLOR=royalblue][B]Col(C)      [/B][/COLOR] [COLOR=royalblue][B]Col(D)     [/B][/COLOR][COLOR=royalblue][B]Col(E)     [/B][/COLOR][COLOR=royalblue][B]Col(F)     [/B][/COLOR][COLOR=royalblue][B]Col(G)     [/B][/COLOR]
1.      data1   data2   data3        data4       data5       data6       data7      
2.      data1   data2   data3        data4       data5       data6       data7      
3.      data1   data2   data3        data4       data5       data6       data7      
4.      data1   data2   data3        data4       data5       data6       data7      
5.      data1   data2   data3        data4       data5       data6       data7      
6.      data1   data2   data3        data4       data5       data6       data7      
7.      data1   data2                                                               
8.      data1   data2   (Cell "C8")  Jan         Feb         Mar         April      
9.      data1   data2   Carrots                  10/02/2011              01/04/2011 
10.     data1   data2   Tates        01/01/2011              21/03/2011  01/04/2011 
11.     data1   data2   Leeks        12/01/2011  10/02/2011  21/03/2011  01/04/2011 
12.     data1   data2   Onions       25/01/2011  26/02/2011  21/03/2011             
13.     data1   data2                                                               
14.     data1   data2                                                               
15.     data1   data2

[COLOR=navy]Sub[/COLOR] MG23Feb09
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] DtRng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dt [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] ColRng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]With[/COLOR] Sheets("Sheet2")
    [COLOR=navy]Set[/COLOR] DtRng = .Range(.Range("C8"), .Range("C" & rows.Count).End(xlUp))
    [COLOR=navy]Set[/COLOR] ColRng = .Range(.Range("C8"), .Cells(8, .Columns.Count).End(xlToLeft))
    [COLOR=navy]Set[/COLOR] DtRng = DtRng.Resize(, ColRng.Count)
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("sheet1")
    [COLOR=navy]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
    Rng.Offset(, 1).Resize(, 10).ClearContents
    ReDim Ray(1 To Rng.Count, 1 To Columns.Count)
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
        [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
            n = n + 1
            .Add Dn.value, Array(n, 1)
                [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dt [COLOR=navy]In[/COLOR] DtRng
                    [COLOR=navy]If[/COLOR] Dt = Dn [COLOR=navy]Then[/COLOR]
                         Q = .Item(Dn.value)
                         Ray(Q(0), Q(1)) = Sheets("Sheet2").Range("C" & Dt.row)
                         Q(1) = Q(1) + 1
                         .Item(Dn.value) = Q
                    oMax = Application.Max(Q(1), oMax)
                    [COLOR=navy]End[/COLOR] If
                [COLOR=navy]Next[/COLOR] Dt
        [COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("Sheet13")
.Range("B1").Resize(Rng.Count, oMax) = Ray
[COLOR=navy]End[/COLOR] With
MsgBox "Code Run !!"
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[asylum]

Hi Mick,

Thats absolutley fantatstic, thanks very much for this,

Just one small slip, in case others follow this thread, the last reference to sheet 13 should read sheet1, but this works a treat, I really appraciate your help.

I have abit more development of my sheet to do, and there may be one slight 'addition' later, but I'll see if its needed, I may relight this thread!

Cheers

Andy