Calculating number of events within a rolling 6 second period

[stu_iow]

Hello there,

I have a guideline that suggest when you are driving looking at your Smartphone for greater than 2 seconds within any 6 second period leads to an increased risk of a crash. I have an Excel sheet with two columns, one is the length of time of a single glance, and the other is where the driver is looking, see below. (For your information 5 is looking forward and 6 is at the phone).

5	1.212
6	0.276
5	0.596
6	0.412
5	1.21575
6	0.356
5	0.664
6	0.3
5	0.684
6	0.424
5	0.92
6	0.384
5	2.61975
6	0.42
5	1.212
6	0.284
5	0.53575
6	0.496
4	0.232
5	0.852
2	0.596
5	2.112
6	0.29975
5	0.628
8	0.376
5	1.888
2	0.536
5	0.96
8	0.35575

<colgroup><col style="width: 48pt;" span="2" width="64"> <tbody>
</tbody>

So how can I calculate: 1) On how many occasions the times associated with 5 were greater than 2 seconds (this is the total time for all 5 within this period) within any rolling 6 second period (or as close to but greater than 6 seconds). 2) More difficult, but is it possible to calculate an average time looking at the phone (5) for any rolling 6 second period.

I hope this makes sense, if it doesn't I can clarify.

Thanks,

Stewart.

 

[MickG]

Try this:-
The code first loops throught column "A" , adding the times in column "B" until the sum is greater than 6.
This creates a sun Range.
The code then loop through this sub range counting the column a "5"'s that are greater thnan 2.
This is repeated restarting the entire loop from each seperate row, to give a rolling average.
At the same time the Average for Each 6 sec period is taken for Column "A" 5's.
the results are shown in column "C" for the 2 secs periods and in column "E" for the Average time.
Each line in column "E" represents 1 loop of the Range.
I hope the results make some sense to you !!!

[COLOR="Navy"]Sub[/COLOR] MG20Jun07
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Tim [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Cl [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [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] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] tot [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] TTav [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] T
[COLOR="Navy"]Dim[/COLOR] Tt
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] n = 1 To Rng.Count
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A" & n), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Tim = Tim + Dn.Offset(, 1)
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Dn
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
        [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]If[/COLOR] Tim > 6 [COLOR="Navy"]Then[/COLOR]
          [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Cl [COLOR="Navy"]In[/COLOR] nRng
                [COLOR="Navy"]If[/COLOR] Cl = 5 And Cl.Offset(, 1) > 2 [COLOR="Navy"]Then[/COLOR]
                    c = c + 1
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]If[/COLOR] Cl = 5 [COLOR="Navy"]Then[/COLOR] av = av + Cl.Offset(, 1)
            [COLOR="Navy"]Next[/COLOR] Cl
       [COLOR="Navy"]Set[/COLOR] nRng = Nothing
       Tim = 0
       
tav = tav & ", " & Format(av / 6, "0.000")
av = 0
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
TTav = TTav & Chr(10) & Mid(tav, 2)
tav = ""
tot = tot & Chr(10) & c
c = 0
[COLOR="Navy"]Next[/COLOR] n
    T = Split(Mid(tot, 2), Chr(10))
    Range("C1").Resize(UBound(T)) = Application.Transpose(T)
    Tt = Split(Mid(TTav, 2), Chr(10))
    Range("E1").Resize(UBound(Tt)) = Application.Transpose(Tt)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[stu_iow]

Hello Mick,

This was my first dabble in VBA so I appologise for the delay in reponding/thanking you. What you wrote works well for what I asked, but I realise that I wasn't clear enough. I am looking to see if the sum off all the 5's in the sub range add up to greater than 2, rather than if one individual 5 is greater than 2 (i.e. say there are three 5's in the sub range of 0.6, 1.2 and 0.4, these would add up to greater than 2 rather than none of them are above two. Also all the numbers in column C (with the excetion of C1) are zeros, what should this be indicating? Finally what are the numbers in E1 representing?

Sorry for all the questions but many thanks.

 

[J.Ty.]

Hi,

I have quite different solution, using formulas only.
Your original data is in column B and C.
Column A is numbering of events, from 1 (timer switched on), and every recording is an event.
Column Di is the time when that events begins and E is the time when this event ends.

F and G are rows of 6 second periods, F is the beginning of the period and G is its end. H is during which event the period starts and F is during which event that period ends.

Generally, the phone looking time is the sum of the lengths of events with 5 in column B, which cover the period, minus the excess (column J), which is the phone looking time which belongs to the events, but is outside of the period.

L is the value you are looking for.

E.g., the period between second 2 and second 8 corresponds to events from 4 (which begins at time 1.488) to 14 (which ends at time 10.0635). Both of these events where "looking at the phone".

So in order to calculate the time spent looking at the phone during this period we sum all the phone looking events between 2 and 14, minus:
[*] time between 1.488 and 2, which is the part of event 2 before second 2
[*] time between 8 and 10.0635, which is the part of event 14 after second 8

Please exchange ; into , in all formulas. Then copy them downward. The formulas are not good for adding an extra header.

J.Ty.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L
1	1	0	0	0	0	from second	to second	from event	to event	excess		phone time
2	2	5	1.212	0	1.212	0	6	2	11	0		4.37175
3	3	6	0.276	1.212	1.488	1	7	2	12	1.05975		4.232
4	4	5	0.596	1.488	2.084	2	8	4	14	2.5755		4.124
5	5	6	0.412	2.084	2.496	3	9	6	14	1.5675		4.536
6	6	5	1.21575	2.496	3.71175	4	10	7	14	0.0635		4.82425
7	7	6	0.356	3.71175	4.06775	5	11	9	16	0.6955		4.74025
8	8	5	0.664	4.06775	4.73175	6	12	11	18	0.51525		4.77225
9	9	6	0.3	4.73175	5.03175
10	10	5	0.684	5.03175	5.71575
11	11	6	0.424	5.71575	6.13975
12	12	5	0.92	6.13975	7.05975
13	13	6	0.384	7.05975	7.44375
14	14	5	2.61975	7.44375	10.0635
Sheet1

 

[MickG]

Hopefully this will be better
Results as headers Columns C to G.

[COLOR="Navy"]Sub[/COLOR] MG21Jun17
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Tim         [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Cl          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c           [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] nRng        [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Av          [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Frng        [COLOR="Navy"]As[/COLOR] Range
c = 1
Range("C1:G1") = Array("Address", "5 Ac/Time", "Above/below 2", "Av of 5/Period", "Act Time/Period")
[COLOR="Navy"]Set[/COLOR] Frng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] n = 1 To Frng.Count
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A" & n), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Tim = Tim + Dn.Offset(, 1)
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Dn
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
        [COLOR="Navy"]End[/COLOR] If
  
        [COLOR="Navy"]If[/COLOR] Tim > 6 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Cl [COLOR="Navy"]In[/COLOR] nRng
                [COLOR="Navy"]If[/COLOR] Cl = 5 [COLOR="Navy"]Then[/COLOR]
                    Av = Av + Cl.Offset(, 1)
                [COLOR="Navy"]End[/COLOR] If
         [COLOR="Navy"]Next[/COLOR] Cl
                c = c + 1
                Cells(c, "C") = nRng.Address
                Cells(c, "D") = Av
                Cells(c, "E") = IIf(Av > 2, "Above 2", "Below 2")
                Cells(c, "F") = Format(Av / 6, "0.00")
                Cells(c, "G") = Tim
                [COLOR="Navy"]Set[/COLOR] nRng = Nothing
                Tim = 0
                Av = 0
      [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]Set[/COLOR] nRng = Nothing
    Tim = 0
    Av = 0
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[stu_iow]

Hello again,

Both options worked perfectly, so thank you both for that. All I need to do now is find a way to interpret the results!

Thanks again and much obliged.

 

[J.Ty.]

Good luck and thanks for the feedback!

J.Ty.