Creating calendar view from list of data

[danhodges99]

Hi – I hope you can help, this is proving beyond me…
I have two tables. The first contains the data, in this case a list of activities carried out in a personal fitness log and the date of each:

Date	Activity
01/08/2016	Running <tbody> </tbody>
01/08/2016	Cycling
02/08/2016	Running
02/08/2016	Rowing
02/08/2016	Gym
05/08/2016	Running
07/08/2016	Running
07/08/2016	Running
07/08/2016	Running
07/08/2016	Gym
07/08/2016	Cycling
09/08/2016	Rowing
10/08/2016	Rowing
10/08/2016	Running
10/08/2016	Running

<tbody>
</tbody>

The second table is meant to be a dashboard calendar summary of the number of each activity on each date, and should look like this:

Date	Rowing	Running	Cycling	Gym
01/08/2016	0	1	1	0
02/08/2016	1	1	0	1
03/08/2016	0	0	0	0
04/08/2016	0	0	0	0
05/08/2016	0	1	0	0
06/08/2016	0	0	0	0
07/08/2016	0	3	1	1
08/08/2016	0	0	0	0
09/08/2016	1	0	0	0
10/08/2016	1	2	0	0

<tbody>
</tbody>

I’ve almost managed it using INDEX & MATCH. However, when a day has multiple activities, the calendar view only captures the first activity on each day and ignores the rest – leaving my figures inaccurate.

Any help here is greatly appreciated - thanks.

 

[MickG]

If you are prepared to use some code, the below will create the Whole calendar with Your data starting "A1" and the results starting "D1".

[COLOR="Navy"]Sub[/COLOR] MG05Jul00
[COLOR="Navy"]Dim[/COLOR] Ray() [COLOR="Navy"]As[/COLOR] Variant, Dn [COLOR="Navy"]As[/COLOR] Range, Rng [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] p [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] MxDt [COLOR="Navy"]As[/COLOR] Date, MnDt [COLOR="Navy"]As[/COLOR] Date
[COLOR="Navy"]Dim[/COLOR] Col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
Col = 1
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    MxDt = Application.Max(Rng.Offset(, -1))
        MnDt = Application.Min(Rng.Offset(, -1))
            ReDim Preserve Ray(1 To DateDiff("d", MnDt, MxDt) + 2, 1 To 1)
                [COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
                    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
                        Dic.CompareMode = 1
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, -1).Value) [COLOR="Navy"]Then[/COLOR]
                Dic(Dn.Value).Add (Dn.Offset(, -1).Value), 1
            [COLOR="Navy"]Else[/COLOR]
                Dic(Dn.Value).Item(Dn.Offset(, -1).Value) = Dic(Dn.Value).Item(Dn.Offset(, -1).Value) + 1
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn

ReDim Ray(1 To DateDiff("d", MnDt, MxDt) + 2, 1 To Dic.Count + 1)
        Col = 1: Ray(1, 1) = "Date"
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.keys
            Col = Col + 1
            Ray(1, Col) = k
        [COLOR="Navy"]Next[/COLOR] k

[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
    Ray(n, 1) = MnDt
    [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
        Ray(n, Ac) = 0
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(Ray(1, Ac))
                [COLOR="Navy"]If[/COLOR] Ray(n, 1) = p [COLOR="Navy"]Then[/COLOR] Ray(n, Ac) = Dic(Ray(1, Ac)).Item(p)
            [COLOR="Navy"]Next[/COLOR] p
    [COLOR="Navy"]Next[/COLOR] Ac
    MnDt = DateAdd("d", 1, MnDt)
[COLOR="Navy"]Next[/COLOR] n

[COLOR="Navy"]With[/COLOR] Range("D1").Resize(UBound(Ray, 1), UBound(Ray, 2))
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
    .HorizontalAlignment = xlCenter
[COLOR="Navy"]End[/COLOR] With
   
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick