Summarise data recorded by date in date ranges

L

lukeh88

New Member
Joined
Nov 8, 2018
Messages
4
Hi - I've been madly googling this problem and cannot find anything that quite solves it for me. Looking to this forum which has helped me so many times before (although first time posting a question!).

I have data capturing number of hours and pay rate, by person, each day. What I want to do is summarise by each person, with a date range. This will be for thousands of people, so obviously open to VBA.
Example of the data;

[TABLE="class: grid, width: 704"]
<tbody>[TR]
[TD][/TD]
[TD]1/01/2018[/TD]
[TD]2/01/2018[/TD]
[TD]3/01/2018[/TD]
[TD]4/01/2018[/TD]
[TD]5/01/2018[/TD]
[TD]6/01/2018[/TD]
[TD]7/01/2018[/TD]
[TD]8/01/2018[/TD]
[TD]9/01/2018[/TD]
[TD]10/01/2018[/TD]
[/TR]
[TR]
[TD]Person 1[/TD]
[TD]4.5[/TD]
[TD]4.5[/TD]
[TD]4.5[/TD]
[TD]4.5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]Person 1[/TD]
[TD]18.10[/TD]
[TD]18.10[/TD]
[TD]18.10[/TD]
[TD]19.00[/TD]
[TD]19.00[/TD]
[TD]19.00[/TD]
[TD]19.00[/TD]
[TD]19.50[/TD]
[TD]19.50[/TD]
[TD]19.50[/TD]
[/TR]
[TR]
[TD]Person 2[/TD]
[TD]4.5[/TD]
[TD]4.5[/TD]
[TD]4.5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]Person 2[/TD]
[TD]18.50[/TD]
[TD]18.50[/TD]
[TD]19.00[/TD]
[TD]19.00[/TD]
[TD]19.00[/TD]
[TD]21.50[/TD]
[TD]21.50[/TD]
[TD]21.50[/TD]
[TD]21.50[/TD]
[TD]21.50[/TD]
[/TR]
</tbody>[/TABLE]

Ideal end state;
[TABLE="class: grid, width: 345"]
<tbody>[TR]
[TD][/TD]
[TD]Start[/TD]
[TD]End[/TD]
[TD]Hours[/TD]
[TD]Rate[/TD]
[/TR]
[TR]
[TD]Person 1[/TD]
[TD]1/01/2018[/TD]
[TD]3/01/2018[/TD]
[TD]4.5[/TD]
[TD]18.10[/TD]
[/TR]
[TR]
[TD]Person 1[/TD]
[TD]4/01/2018[/TD]
[TD]4/01/2018[/TD]
[TD]4.5[/TD]
[TD]19.00[/TD]
[/TR]
[TR]
[TD]Person 1[/TD]
[TD]5/01/2018[/TD]
[TD]7/01/2018[/TD]
[TD]5[/TD]
[TD]19.00[/TD]
[/TR]
[TR]
[TD]Person 1[/TD]
[TD]8/01/2018[/TD]
[TD]10/01/2018[/TD]
[TD]5[/TD]
[TD]19.50[/TD]
[/TR]
[TR]
[TD]Person 2[/TD]
[TD]1/01/2018[/TD]
[TD]2/01/2018[/TD]
[TD]4.5[/TD]
[TD]18.50[/TD]
[/TR]
[TR]
[TD]Person 2[/TD]
[TD]3/01/2018[/TD]
[TD]3/01/2018[/TD]
[TD]4.5[/TD]
[TD]19.00[/TD]
[/TR]
[TR]
[TD]Person 2[/TD]
[TD]4/01/2018[/TD]
[TD]5/01/2018[/TD]
[TD]5[/TD]
[TD]19.00[/TD]
[/TR]
[TR]
[TD]Person 2[/TD]
[TD]6/01/2018[/TD]
[TD]10/01/2018[/TD]
[TD]5[/TD]
[TD]21.50[/TD]
[/TR]
</tbody>[/TABLE]


Would really appreciate any assistance here.

Thanks
Luke
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
Try this , Result on sheet2.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG08Nov19
[COLOR="Navy"]Dim[/COLOR] Ray         [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Q           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Txt         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

Ray = ActiveSheet.Cells(1).CurrentRegion
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   
   [COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1) [COLOR="Navy"]Step[/COLOR] 2
        [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
            Txt = Ray(n, Ac) & "," & Ray(n + 1, Ac)
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(n, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, 1)).exists(Txt) [COLOR="Navy"]Then[/COLOR]
                Dic(Ray(n, 1)).Add (Txt), Array(Ray(1, Ac), Ray(1, Ac))
        [COLOR="Navy"]Else[/COLOR]
            Q = Dic(Ray(n, 1)).Item(Txt)
                Q(1) = Ray(1, Ac)
            Dic(Ray(n, 1)).Item(Txt) = Q
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]Next[/COLOR] n
   
   ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 5)
   nray(1, 1) = "Person": nray(1, 2) = "Start": nray(1, 3) = "End"
   nray(1, 4) = "Hours": nray(1, 5) = "Rate"
   c = 1
    
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
             c = c + 1
             nray(c, 1) = k
             nray(c, 2) = Dic(k).Item(p)(0)
             nray(c, 3) = Dic(k).Item(p)(1)
             nray(c, 4) = Split(p, ",")(0)
             nray(c, 5) = Split(p, ",")(1)
        [COLOR="Navy"]Next[/COLOR] p
    [COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 5)
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks Mick,

This works brilliantly. Without realising, additional data points will now come through to add to my problem. I'll give it a try myself but would very much appreciate your guidance, if I were to have another line of data (ie. sales units), what would I need to add to the code?

MickG said:
Try this , Result on sheet2.
Code: 
[COLOR=Navy]Sub[/COLOR] MG08Nov19
[COLOR=Navy]Dim[/COLOR] Ray         [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Ac          [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Dic         [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Q           [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Txt         [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] k           [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] p           [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] c           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]

Ray = ActiveSheet.Cells(1).CurrentRegion
 [COLOR=Navy]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   
   [COLOR=Navy]For[/COLOR] n = 2 To UBound(Ray, 1) [COLOR=Navy]Step[/COLOR] 2
        [COLOR=Navy]For[/COLOR] Ac = 2 To UBound(Ray, 2)
            Txt = Ray(n, Ac) & "," & Ray(n + 1, Ac)
            [COLOR=Navy]If[/COLOR] Not Dic.exists(Ray(n, 1)) [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]Set[/COLOR] Dic(Ray(n, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR=Navy]End[/COLOR] If
        
        [COLOR=Navy]If[/COLOR] Not Dic(Ray(n, 1)).exists(Txt) [COLOR=Navy]Then[/COLOR]
                Dic(Ray(n, 1)).Add (Txt), Array(Ray(1, Ac), Ray(1, Ac))
        [COLOR=Navy]Else[/COLOR]
            Q = Dic(Ray(n, 1)).Item(Txt)
                Q(1) = Ray(1, Ac)
            Dic(Ray(n, 1)).Item(Txt) = Q
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] Ac
    [COLOR=Navy]Next[/COLOR] n
   
   ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 5)
   nray(1, 1) = "Person": nray(1, 2) = "Start": nray(1, 3) = "End"
   nray(1, 4) = "Hours": nray(1, 5) = "Rate"
   c = 1
    
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] k [COLOR=Navy]In[/COLOR] Dic.Keys
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] p [COLOR=Navy]In[/COLOR] Dic(k)
             c = c + 1
             nray(c, 1) = k
             nray(c, 2) = Dic(k).Item(p)(0)
             nray(c, 3) = Dic(k).Item(p)(1)
             nray(c, 4) = Split(p, ",")(0)
             nray(c, 5) = Split(p, ",")(1)
        [COLOR=Navy]Next[/COLOR] p
    [COLOR=Navy]Next[/COLOR] k
[COLOR=Navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 5)
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...
 
Upvote 0
Hi Mick,
Thanks for coming back so quickly - suspect we might be on a significant time difference! Apologies for the revisit, turns out the problem was more complicated than I originally realised. I'm trying to avoid 6 months of pain creating this work around. We have inherently related data points being stored on a daily basis, but they are independent of each other. We need to be able to see what occurred over a given time period, not just on any given day. As such, the data in raw format appears as below;
[TABLE="class: grid, width: 861"]
<tbody>[TR]
[TD]Person ID
[/TD]
[TD]Data type
[/TD]
[TD]1/01/2018
[/TD]
[TD]2/01/2018
[/TD]
[TD]3/01/2018
[/TD]
[TD]4/01/2018
[/TD]
[TD]5/01/2018
[/TD]
[TD]6/01/2018
[/TD]
[TD]7/01/2018
[/TD]
[TD]8/01/2018
[/TD]
[TD]9/01/2018
[/TD]
[TD]10/01/2018
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]Hours
[/TD]
[TD]4
[/TD]
[TD]4
[/TD]
[TD]4
[/TD]
[TD]4
[/TD]
[TD]4
[/TD]
[TD]4
[/TD]
[TD]5
[/TD]
[TD]5
[/TD]
[TD]5
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]Rate
[/TD]
[TD]18.5
[/TD]
[TD]18.5
[/TD]
[TD]18.5
[/TD]
[TD]18.5
[/TD]
[TD]18.5
[/TD]
[TD]19
[/TD]
[TD]19
[/TD]
[TD]19
[/TD]
[TD]19
[/TD]
[TD]19
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]Units of #1
[/TD]
[TD]8500
[/TD]
[TD]8500
[/TD]
[TD]8500
[/TD]
[TD]8500
[/TD]
[TD]8500
[/TD]
[TD]9000
[/TD]
[TD]9000
[/TD]
[TD]9000
[/TD]
[TD]9000
[/TD]
[TD]9000
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]Units of #2
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]900
[/TD]
[TD]900
[/TD]
[TD]900
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]Transport (mins)
[/TD]
[TD]35
[/TD]
[TD]35
[/TD]
[TD]35
[/TD]
[TD]35
[/TD]
[TD]35
[/TD]
[TD]35
[/TD]
[TD]35
[/TD]
[TD]45
[/TD]
[TD]45
[/TD]
[TD]45
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]Data (gb)
[/TD]
[TD]1.1
[/TD]
[TD]1.1
[/TD]
[TD]1.1
[/TD]
[TD]1.1
[/TD]
[TD]1.1
[/TD]
[TD]1.1
[/TD]
[TD]1.1
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]Territory Code
[/TD]
[TD]xxyy2
[/TD]
[TD]xxyy2
[/TD]
[TD]xxyy4
[/TD]
[TD]xxyy4
[/TD]
[TD]xxyy2
[/TD]
[TD]xxyy2
[/TD]
[TD]xxyy2
[/TD]
[TD]xxyy2
[/TD]
[TD]xxyy2
[/TD]
[TD]xxyy2
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]Region Code
[/TD]
[TD]xxe
[/TD]
[TD]xxe
[/TD]
[TD]xxe
[/TD]
[TD]yyr
[/TD]
[TD]yyr
[/TD]
[TD]yyr
[/TD]
[TD]yyr
[/TD]
[TD]yyr
[/TD]
[TD]yyr
[/TD]
[TD]yyr
[/TD]
[/TR]
[TR]
[TD]1112
[/TD]
[TD]Hours
[/TD]
[TD]8
[/TD]
[TD]8
[/TD]
[TD]8
[/TD]
[TD]8
[/TD]
[TD]8
[/TD]
[TD]8
[/TD]
[TD]8
[/TD]
[TD]7
[/TD]
[TD]7
[/TD]
[TD]7
[/TD]
[/TR]
[TR]
[TD]1112
[/TD]
[TD]Rate
[/TD]
[TD]21
[/TD]
[TD]21
[/TD]
[TD]21
[/TD]
[TD]21
[/TD]
[TD]21
[/TD]
[TD]21
[/TD]
[TD]21
[/TD]
[TD]21
[/TD]
[TD]21
[/TD]
[TD]21
[/TD]
[/TR]
[TR]
[TD]1112
[/TD]
[TD]Units of #1
[/TD]
[TD]4500
[/TD]
[TD]4500
[/TD]
[TD]4500
[/TD]
[TD]4500
[/TD]
[TD]4500
[/TD]
[TD]4500
[/TD]
[TD]4500
[/TD]
[TD]4500
[/TD]
[TD]3500
[/TD]
[TD]3500
[/TD]
[/TR]
[TR]
[TD]1112
[/TD]
[TD]Units of #2
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]1200
[/TD]
[TD]2100
[/TD]
[TD]2100
[/TD]
[TD]2100
[/TD]
[TD]2100
[/TD]
[/TR]
[TR]
[TD]1112
[/TD]
[TD]Transport (mins)
[/TD]
[TD]15
[/TD]
[TD]15
[/TD]
[TD]15
[/TD]
[TD]15
[/TD]
[TD]15
[/TD]
[TD]15
[/TD]
[TD]15
[/TD]
[TD]15
[/TD]
[TD]15
[/TD]
[TD]15
[/TD]
[/TR]
[TR]
[TD]1112
[/TD]
[TD]Data (gb)
[/TD]
[TD]1.1
[/TD]
[TD]1.1
[/TD]
[TD]1.1
[/TD]
[TD]1.1
[/TD]
[TD]2.5
[/TD]
[TD]2.5
[/TD]
[TD]2.5
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[/TR]
[TR]
[TD]1112
[/TD]
[TD]Territory Code
[/TD]
[TD]xxyy2
[/TD]
[TD]xxyy2
[/TD]
[TD]xxyy4
[/TD]
[TD]xxyy4
[/TD]
[TD]xxyy4
[/TD]
[TD]xxyy4
[/TD]
[TD]xxyy4
[/TD]
[TD]xxyy5
[/TD]
[TD]xxyy5
[/TD]
[TD]xxyy5
[/TD]
[/TR]
[TR]
[TD]1112
[/TD]
[TD]Region Code
[/TD]
[TD]xxq
[/TD]
[TD]xxq
[/TD]
[TD]xxq
[/TD]
[TD]xxq
[/TD]
[TD]xxq
[/TD]
[TD]xxq
[/TD]
[TD]xxq
[/TD]
[TD]xxq
[/TD]
[TD]xx4
[/TD]
[TD]xx4
[/TD]
[/TR]
</tbody>[/TABLE]

The output should look like
[TABLE="class: grid, width: 757"]
<tbody>[TR]
[TD]Person ID
[/TD]
[TD]Start
[/TD]
[TD]End
[/TD]
[TD]Hours
[/TD]
[TD]Rate
[/TD]
[TD]Units of #1
[/TD]
[TD]Units of #2
[/TD]
[TD]Transport (mins)
[/TD]
[TD]Data (gb)
[/TD]
[TD]Territory Code
[/TD]
[TD]Region Code
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]1/01/2018
[/TD]
[TD]3/01/2018
[/TD]
[TD]4
[/TD]
[TD]18.5
[/TD]
[TD]8500
[/TD]
[TD]1200
[/TD]
[TD]35
[/TD]
[TD]1.1
[/TD]
[TD]xxyy4
[/TD]
[TD]xxe
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]4/01/2018
[/TD]
[TD]4/01/2018
[/TD]
[TD]4
[/TD]
[TD]18.5
[/TD]
[TD]8500
[/TD]
[TD]1200
[/TD]
[TD]35
[/TD]
[TD]1.1
[/TD]
[TD]xxyy4
[/TD]
[TD]yyr
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]5/01/2018
[/TD]
[TD]5/01/2018
[/TD]
[TD]4
[/TD]
[TD]18.5
[/TD]
[TD]8500
[/TD]
[TD]1200
[/TD]
[TD]35
[/TD]
[TD]1.1
[/TD]
[TD]xxyy2
[/TD]
[TD]yyr
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]6/01/2018
[/TD]
[TD]6/01/2018
[/TD]
[TD]4
[/TD]
[TD]19
[/TD]
[TD]9000
[/TD]
[TD]1200
[/TD]
[TD]35
[/TD]
[TD]1.1
[/TD]
[TD]xxyy2
[/TD]
[TD]yyr
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]7/01/2018
[/TD]
[TD]7/01/2018
[/TD]
[TD]5
[/TD]
[TD]19
[/TD]
[TD]9000
[/TD]
[TD]1200
[/TD]
[TD]35
[/TD]
[TD]1.1
[/TD]
[TD]xxyy2
[/TD]
[TD]yyr
[/TD]
[/TR]
[TR]
[TD]1111
[/TD]
[TD]8/01/2018
[/TD]
[TD]10/01/2018
[/TD]
[TD]5
[/TD]
[TD]19
[/TD]
[TD]9000
[/TD]
[TD]900
[/TD]
[TD]45
[/TD]
[TD]3
[/TD]
[TD]xxyy2
[/TD]
[TD]yyr
[/TD]
[/TR]
</tbody>[/TABLE]

Any thoughts appreciated. Thank you again
 
Upvote 0
Sorry for late reply:-
Try this for results in sheet2.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG14Nov14
[COLOR="Navy"]Dim[/COLOR] Ray         [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Q           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Txt         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

Ray = ActiveSheet.Cells(1).CurrentRegion
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   
   [COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1) [COLOR="Navy"]Step[/COLOR] 8
        [COLOR="Navy"]For[/COLOR] Ac = 3 To UBound(Ray, 2)
           [COLOR="Navy"]With[/COLOR] Application
                Txt = Join(.Transpose(.Index(Ray, Evaluate("row(" & n & ":" & n + 7 & ")"), Ac)), ",")
            [COLOR="Navy"]End[/COLOR] With
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(n, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, 1)).exists(Txt) [COLOR="Navy"]Then[/COLOR]
                Dic(Ray(n, 1)).Add (Txt), Array(Ray(1, Ac), Ray(1, Ac))
        [COLOR="Navy"]Else[/COLOR]
            Q = Dic(Ray(n, 1)).Item(Txt)
                Q(1) = Ray(1, Ac)
            Dic(Ray(n, 1)).Item(Txt) = Q
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]Next[/COLOR] n
   
   ReDim nRay(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 11)
   nRay(1, 1) = "Person": nRay(1, 2) = "Start": nRay(1, 3) = "End"
   nRay(1, 4) = "Hours": nRay(1, 5) = "Rate": nRay(1, 6) = "Units of [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] "
   nRay(1, 7) = "Units of [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2]#2[/URL] ": nRay(1, 8) = "Transport (mins)"
   nRay(1, 9) = "Data (gb)": nRay(1, 10) = "Territory Code": nRay(1, 11) = "Region Code"
    c = 1
    
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
             c = c + 1
             nRay(c, 1) = k
             nRay(c, 2) = Dic(k).Item(p)(0)
             nRay(c, 3) = Dic(k).Item(p)(1)
             nRay(c, 4) = Split(p, ",")(0)
             nRay(c, 5) = Split(p, ",")(1)
             nRay(c, 6) = Split(p, ",")(2)
             nRay(c, 7) = Split(p, ",")(3)
             nRay(c, 8) = Split(p, ",")(4)
             nRay(c, 9) = Split(p, ",")(5)
             nRay(c, 10) = Split(p, ",")(6)
             nRay(c, 11) = Split(p, ",")(7)
        [COLOR="Navy"]Next[/COLOR] p
    [COLOR="Navy"]Next[/COLOR] k

[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 11)
    .Value = nRay
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] With


[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Mick - this has worked perfectly. I'm going to try on a much larger data set, and see how that goes but not expecting errors (unless by my own making frankly). The code is very efficient on my test data.

You have saved me a lot of time!! Thank you!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
HELP IDENTIFY ORIGINAL START DATE BASED ON CONTINOUS SERVICE RULES
Replies
0
Views
568
mrshuck
M
M
  • Question Question
Dynamic Formula
Replies
2
Views
293
Mengli
M
L
  • Question Question
INDEX MATCH
Replies
1
Views
341
Fluff
Fluff
S
  • Question Question
Formatting Midnight in a date to 24 instead of 0:00
Replies
4
Views
613
shepcs
S
A
  • Solved
Extract duplicates dates and insert TOTAL row for each duplicates dates
Replies
4
Views
132
Alaa mg
A

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top