complicated way of dividing data

bertusavius

Board Regular
Joined
Feb 28, 2008
Messages
82
[TABLE="width: 635"]
<TBODY>[TR]
[TD="width: 847, bgcolor: transparent"]I have a table with a list of events that have ID, two time-values and two 'trip values'.



[TABLE="class: grid, width: 200"]
<TBODY>[TR]
[TD="width: 21, bgcolor: #4f81bd"]ID
[/TD]
[TD="width: 66, bgcolor: #4f81bd"]Timestart
[/TD]
[TD="width: 65, bgcolor: #4f81bd"]Timestop
[/TD]
[TD="width: 57, bgcolor: #4f81bd"]tripstart
[/TD]
[TD="width: 56, bgcolor: #4f81bd"]tripstop
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]25
[/TD]
[TD="bgcolor: #dce6f1, align: right"]6:55
[/TD]
[TD="bgcolor: #dce6f1, align: right"]7:55
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259010
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259030
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]25
[/TD]
[TD="bgcolor: transparent, align: right"]7:06
[/TD]
[TD="bgcolor: transparent, align: right"]7:55
[/TD]
[TD="bgcolor: transparent, align: right"]259011
[/TD]
[TD="bgcolor: transparent, align: right"]259030
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]25
[/TD]
[TD="bgcolor: #dce6f1, align: right"]7:11
[/TD]
[TD="bgcolor: #dce6f1, align: right"]7:57
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259013
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259030
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]25
[/TD]
[TD="bgcolor: transparent, align: right"]7:17
[/TD]
[TD="bgcolor: transparent, align: right"]7:57
[/TD]
[TD="bgcolor: transparent, align: right"]259014
[/TD]
[TD="bgcolor: transparent, align: right"]259030
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]25
[/TD]
[TD="bgcolor: #dce6f1, align: right"]7:23
[/TD]
[TD="bgcolor: #dce6f1, align: right"]7:57
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259015
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259030
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]25
[/TD]
[TD="bgcolor: transparent, align: right"]7:27
[/TD]
[TD="bgcolor: transparent, align: right"]7:59
[/TD]
[TD="bgcolor: transparent, align: right"]259017
[/TD]
[TD="bgcolor: transparent, align: right"]259031
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]25
[/TD]
[TD="bgcolor: #dce6f1, align: right"]7:29
[/TD]
[TD="bgcolor: #dce6f1, align: right"]7:58
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259017
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259031
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]25
[/TD]
[TD="bgcolor: transparent, align: right"]7:40
[/TD]
[TD="bgcolor: transparent, align: right"]7:59
[/TD]
[TD="bgcolor: transparent, align: right"]259025
[/TD]
[TD="bgcolor: transparent, align: right"]259031
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]25
[/TD]
[TD="bgcolor: #dce6f1, align: right"]8:11
[/TD]
[TD="bgcolor: #dce6f1, align: right"]8:21
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259038
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259043
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]25
[/TD]
[TD="bgcolor: transparent, align: right"]8:41
[/TD]
[TD="bgcolor: transparent, align: right"]9:07
[/TD]
[TD="bgcolor: transparent, align: right"]259049
[/TD]
[TD="bgcolor: transparent, align: right"]259063
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]25
[/TD]
[TD="bgcolor: #dce6f1, align: right"]8:48
[/TD]
[TD="bgcolor: #dce6f1, align: right"]9:16
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259054
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259064
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]78
[/TD]
[TD="bgcolor: #dce6f1, align: right"]13:24
[/TD]
[TD="bgcolor: #dce6f1, align: right"]13:34
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259116
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259122
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]78
[/TD]
[TD="bgcolor: transparent, align: right"]13:40
[/TD]
[TD="bgcolor: transparent, align: right"]14:14
[/TD]
[TD="bgcolor: transparent, align: right"]259122
[/TD]
[TD="bgcolor: transparent, align: right"]259134
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]78
[/TD]
[TD="bgcolor: #dce6f1, align: right"]13:45
[/TD]
[TD="bgcolor: #dce6f1, align: right"]14:22
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259124
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259136
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]78
[/TD]
[TD="bgcolor: transparent, align: right"]13:54
[/TD]
[TD="bgcolor: transparent, align: right"]14:22
[/TD]
[TD="bgcolor: transparent, align: right"]259127
[/TD]
[TD="bgcolor: transparent, align: right"]259136
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]78
[/TD]
[TD="bgcolor: #dce6f1, align: right"]14:03
[/TD]
[TD="bgcolor: #dce6f1, align: right"]14:23
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259130
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259136
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]78
[/TD]
[TD="bgcolor: transparent, align: right"]14:35
[/TD]
[TD="bgcolor: transparent, align: right"]14:58
[/TD]
[TD="bgcolor: transparent, align: right"]259144
[/TD]
[TD="bgcolor: transparent, align: right"]259148
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]78
[/TD]
[TD="bgcolor: #dce6f1, align: right"]14:36
[/TD]
[TD="bgcolor: #dce6f1, align: right"]14:58
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259144
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259148
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]78
[/TD]
[TD="bgcolor: transparent, align: right"]14:43
[/TD]
[TD="bgcolor: transparent, align: right"]15:06
[/TD]
[TD="bgcolor: transparent, align: right"]259145
[/TD]
[TD="bgcolor: transparent, align: right"]259150
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]78
[/TD]
[TD="bgcolor: #dce6f1, align: right"]14:52
[/TD]
[TD="bgcolor: #dce6f1, align: right"]15:38
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259146
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259162
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]78
[/TD]
[TD="bgcolor: transparent, align: right"]15:19
[/TD]
[TD="bgcolor: transparent, align: right"]15:42
[/TD]
[TD="bgcolor: transparent, align: right"]259155
[/TD]
[TD="bgcolor: transparent, align: right"]259163
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]78
[/TD]
[TD="bgcolor: #dce6f1, align: right"]15:27
[/TD]
[TD="bgcolor: #dce6f1, align: right"]15:47
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259157
[/TD]
[TD="bgcolor: #dce6f1, align: right"]259164
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]78
[/TD]
[TD="bgcolor: transparent, align: right"]15:54
[/TD]
[TD="bgcolor: transparent, align: right"]16:02
[/TD]
[TD="bgcolor: transparent, align: right"]259165
[/TD]
[TD="bgcolor: transparent, align: right"]259167
[/TD]
[/TR]
</TBODY>[/TABLE]
[/TD]
[/TR]
</TBODY>[/TABLE]


[TABLE="width: 635"]
<TBODY>[TR]
[TD="width: 847, bgcolor: transparent"]To make things less abstract:
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]The trip-value is the value of a trip meter in a car in kilometers.
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]So the top record actualy says:
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]car nr 25 had an event that started at 06:55 at trip value 259010 and this event stopped at 07:55 coinciding with trip value 259030
You could say this is a list of events with corresponding accumulating properties, so wether the timeID starts or stops doesnt really matter. All the matters is that a certain time corresponds with a certain trip value.




[TABLE="width: 635"]
<TBODY>[TR]
[TD="width: 847, bgcolor: transparent"]Now wat I'd like is to create a measure that transforms and divides this information like this:



[TABLE="class: grid, width: 193"]
<TBODY>[TR]
[TD="width: 62, bgcolor: #4f81bd"]ID
[/TD]
[TD="width: 80, bgcolor: #4f81bd"]binID
[/TD]
[TD="width: 115, bgcolor: #4f81bd"]distance travelled
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]25
[/TD]
[TD="bgcolor: #dce6f1"]0700-0800
[/TD]
[TD="bgcolor: #dce6f1"](value in kms)
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]25
[/TD]
[TD="bgcolor: transparent"]0800-0900
[/TD]
[TD="bgcolor: #dce6f1"](value in kms)
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]25
[/TD]
[TD="bgcolor: #dce6f1"]0900-1000
[/TD]
[TD="bgcolor: #dce6f1"](value in kms)
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]78
[/TD]
[TD="bgcolor: transparent"]0700-0800
[/TD]
[TD="bgcolor: #dce6f1"](value in kms)
[/TD]
[/TR]
[TR]
[TD="bgcolor: #dce6f1, align: right"]78
[/TD]
[TD="bgcolor: #dce6f1"]0800-0900
[/TD]
[TD="bgcolor: #dce6f1"](value in kms)
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent, align: right"]78
[/TD]
[TD="bgcolor: transparent"]0900-1000
[/TD]
[TD="bgcolor: #dce6f1"](value in kms)
[/TD]
[/TR]
</TBODY>[/TABLE]
[/TD]
[/TR]
</TBODY>[/TABLE]


[/TD]
[/TR]
</TBODY>[/TABLE]
[TABLE="width: 341"]
<TBODY>[TR]
[TD="width: 455, bgcolor: transparent"]I have a table to relate to which contains binID, binstart and binstop
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]I also have a table for dates
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Is it even worth contemplating to solve this in Powerpivot, because it seems quite daunting to me atm.


[/TD]
[/TR]
</TBODY>[/TABLE]
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
format.jpg
 
Upvote 0
As soon as I expand the dataset, I'm affraid I'm getting an error in this part of the code:
[TABLE="width: 320"]
<tbody>[TR]
[TD="colspan: 5"]ws.Cells(RowNo, 4) = rec(I - 1).mile - StartMiles[/TD]
[/TR]
</tbody>[/TABLE]

Can you confirm that with this ie example:

[TABLE="width: 514"]
<tbody>[TR]
[TD]Datum[/TD]
[TD]TX start[/TD]
[TD]TX stop[/TD]
[TD]Ch[/TD]
[TD]WP_WAGEN_NUMMER[/TD]
[TD]INS_KILOMETERSTAND[/TD]
[TD]UIT_KILOMETERSTAND[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]6:14[/TD]
[TD="align: right"]6:23[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168300[/TD]
[TD="align: right"]168306[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]6:09[/TD]
[TD="align: right"]6:16[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168298[/TD]
[TD="align: right"]168301[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]7:31[/TD]
[TD="align: right"]8:23[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483682[/TD]
[TD="align: right"]483705[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]8:20[/TD]
[TD="align: right"]8:23[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483704[/TD]
[TD="align: right"]483705[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]7:31[/TD]
[TD="align: right"]8:23[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483682[/TD]
[TD="align: right"]483705[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]7:31[/TD]
[TD="align: right"]8:23[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483682[/TD]
[TD="align: right"]483705[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]6:41[/TD]
[TD="align: right"]8:23[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483660[/TD]
[TD="align: right"]483705[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]6:57[/TD]
[TD="align: right"]7:26[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168311[/TD]
[TD="align: right"]168327[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]7:07[/TD]
[TD="align: right"]7:34[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168313[/TD]
[TD="align: right"]168330[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]7:02[/TD]
[TD="align: right"]7:14[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168312[/TD]
[TD="align: right"]168316[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]8:05[/TD]
[TD="align: right"]8:26[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168345[/TD]
[TD="align: right"]168353[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]8:40[/TD]
[TD="align: right"]8:40[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483715[/TD]
[TD="align: right"]483716[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]9:01[/TD]
[TD="align: right"]9:25[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483732[/TD]
[TD="align: right"]483753[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]9:28[/TD]
[TD="align: right"]9:45[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168373[/TD]
[TD="align: right"]168388[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]10:00[/TD]
[TD="align: right"]10:07[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168393[/TD]
[TD="align: right"]168396[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]10:25[/TD]
[TD="align: right"]10:46[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168404[/TD]
[TD="align: right"]168411[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]10:35[/TD]
[TD="align: right"]10:49[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168408[/TD]
[TD="align: right"]168411[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]10:40[/TD]
[TD="align: right"]10:58[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168408[/TD]
[TD="align: right"]168414[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]11:34[/TD]
[TD="align: right"]11:51[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168424[/TD]
[TD="align: right"]168431[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]11:35[/TD]
[TD="align: right"]11:51[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168424[/TD]
[TD="align: right"]168431[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]11:42[/TD]
[TD="align: right"]11:56[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168427[/TD]
[TD="align: right"]168433[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]11:15[/TD]
[TD="align: right"]11:46[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168418[/TD]
[TD="align: right"]168429[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]11:06[/TD]
[TD="align: right"]11:29[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168416[/TD]
[TD="align: right"]168423[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]11:57[/TD]
[TD="align: right"]12:32[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483771[/TD]
[TD="align: right"]483789[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]11:57[/TD]
[TD="align: right"]12:26[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483771[/TD]
[TD="align: right"]483786[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]11:57[/TD]
[TD="align: right"]12:28[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483771[/TD]
[TD="align: right"]483787[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]13:22[/TD]
[TD="align: right"]13:40[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168456[/TD]
[TD="align: right"]168463[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]13:23[/TD]
[TD="align: right"]13:31[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168456[/TD]
[TD="align: right"]168458[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]12:56[/TD]
[TD="align: right"]13:22[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483799[/TD]
[TD="align: right"]483829[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]14:29[/TD]
[TD="align: right"]14:57[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483829[/TD]
[TD="align: right"]483862[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]12:55[/TD]
[TD="align: right"]13:25[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168448[/TD]
[TD="align: right"]168456[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]13:50[/TD]
[TD="align: right"]14:06[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168465[/TD]
[TD="align: right"]168468[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]13:58[/TD]
[TD="align: right"]14:13[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168466[/TD]
[TD="align: right"]168470[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]14:34[/TD]
[TD="align: right"]14:43[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168475[/TD]
[TD="align: right"]168478[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]14:23[/TD]
[TD="align: right"]14:56[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168472[/TD]
[TD="align: right"]168481[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]14:31[/TD]
[TD="align: right"]15:02[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168474[/TD]
[TD="align: right"]168484[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]14:33[/TD]
[TD="align: right"]15:02[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168475[/TD]
[TD="align: right"]168484[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]15:53[/TD]
[TD="align: right"]16:02[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168498[/TD]
[TD="align: right"]168504[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]15:35[/TD]
[TD="align: right"]16:04[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168493[/TD]
[TD="align: right"]168505[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]15:21[/TD]
[TD="align: right"]15:24[/TD]
[TD="align: right"]5213[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]168489[/TD]
[TD="align: right"]168490[/TD]
[/TR]
[TR]
[TD="align: right"]3-4-2012[/TD]
[TD="align: right"]15:30[/TD]
[TD="align: right"]15:50[/TD]
[TD="align: right"]5357[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]483872[/TD]
[TD="align: right"]483880[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
You must be using some all code. The Current code does not have the line you listed your previous post (#23).

In any event, the code reads in the Dates as "String" (and transforms it to a "Variant") rather than "Dates" so I am not sure why it is not providing the information of the second (results) sheet properly...


In any event, I have made a change to the code to expressly change the the Date from a "variant" to a Date

Code:
Option Explicit
Const DateCol As Integer = 1
Const StartTimeCol As Integer = 2
Const EndTimeCol As Integer = 3
Const DriverCol As Integer = 4
Const CarNoCol As Integer = 5
Const StartMileCol As Integer = 6
Const EndMileCol As Integer = 7
Type typHourRec
    Used As Boolean
    
    MinMin As Long
    MaxMin As Long
    
    MinMile As Long
    MaxMile As Long
End Type
Type typRec
    Key As String
    HrDetail(24) As typHourRec
End Type
Sub Process()
    Dim ws As Worksheet
    Dim Rec() As typRec
    Dim Key As String
    Dim KeyIdx As Integer
    
    Dim RowNo As Long
    Dim LastRow As Long
    
    Dim I As Long
    
    ReDim Rec(0)
    
    Set ws = ThisWorkbook.Worksheets(1)
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For RowNo = 2 To LastRow
        Key = Trim(ws.Cells(RowNo, DateCol)) & "~" & Trim(ws.Cells(RowNo, DriverCol)) & "~" & Trim(ws.Cells(RowNo, CarNoCol))
        KeyIdx = FindKeyIdx(Key, Rec)
        Debug.Print KeyIdx
        If Len(Trim(ws.Cells(RowNo, StartTimeCol))) > 1 Then
            Call UpdateRec(Rec(KeyIdx).HrDetail, StartTimeCol, StartMileCol, ws, RowNo)
            Call UpdateRec(Rec(KeyIdx).HrDetail, EndTimeCol, EndMileCol, ws, RowNo)
        End If
    Next RowNo
    MsgBox "Complete", vbInformation
    Call OutputAll(Rec)
    
End Sub
Function OutputAll(Rec() As typRec)
    Dim ws As Worksheet
    Dim RowNo  As Integer
    Dim KeyIdx As Integer
    
    Dim v As Variant
    Dim I As Integer
    
    Set ws = ThisWorkbook.Worksheets(2)
    ws.Cells.ClearContents
    RowNo = 1
    
    ws.Cells(RowNo, 1) = "Date"
    ws.Cells(RowNo, 2) = "Driver"
    ws.Cells(RowNo, 3) = "Car"
    ws.Cells(RowNo, 4) = "Bucket"
    ws.Cells(RowNo, 5) = "Kms"
    
    For KeyIdx = 1 To UBound(Rec)
        Call OutputData(ws, Rec(KeyIdx).HrDetail, Rec(KeyIdx).Key)
    Next KeyIdx
End Function
Function OutputData(ws As Worksheet, HrDetail() As typHourRec, Key As String)
    Dim I As Integer
    Dim RowNo As Long
    
    Dim v As Variant
    Dim J As Integer
    
    Dim ElapsedMin   As Long
    Dim ElapsedMiles   As Long
    
    Dim Perc As Single
    Dim tempMin As Integer
    Dim tempMiles As Long
    
    RowNo = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row + 1
    
    For I = 2 To UBound(HrDetail)
        
        If HrDetail(I).Used Then
            v = Split(Key, "~")
            If UBound(v) >= 2 Then
                ws.Cells(RowNo, 1) = CDate(v(0))
                ws.Cells(RowNo, 2) = v(1)
                ws.Cells(RowNo, 3) = v(2)
            End If
            'ElapsedMiles = 0
            ElapsedMiles = HrDetail(I).MaxMile - HrDetail(I).MinMile
            
            '***** Determine Offset Adj for the Start of the Hour
            If HrDetail(I - 1).Used Then
                tempMin = (60 - HrDetail(I - 1).MaxMin) + HrDetail(I).MinMin
                tempMiles = HrDetail(I).MinMile - HrDetail(I - 1).MaxMile
                Perc = HrDetail(I).MinMin / tempMin
                ElapsedMiles = ElapsedMiles + (tempMiles * Perc)
            End If
            
            '***** Determine Offset Ady for the Top of the Hour
            If (I < 24) Then
                If HrDetail(I + 1).Used Then
                    tempMin = (60 - HrDetail(I).MaxMin) + HrDetail(I + 1).MinMin
                    tempMiles = HrDetail(I + 1).MinMile - HrDetail(I).MaxMile
                    Perc = (60 - HrDetail(I).MaxMin) / tempMin
                    ElapsedMiles = ElapsedMiles + (tempMiles * Perc)
                End If
            End If
            
            'ws.Cells(RowNo, 1) = Dt
            'ws.Cells(RowNo, 2) = CarNo
            ws.Cells(RowNo, 4) = I & ":00" & " ~ " & (I + 1) & ":00"
            ws.Cells(RowNo, 5) = ElapsedMiles
            RowNo = RowNo + 1
        End If
        
    Next I
            
End Function
Function UpdateRec(HrDetail() As typHourRec, ByVal TimeColNo As Long, ByVal MileColNo As Long, ws As Worksheet, RowNo As Long)
    Dim TempTime As Date
    Dim Idx As Long
    
    TempTime = CDate(ws.Cells(RowNo, TimeColNo))
    Idx = Hour(TempTime)
    
    Select Case HrDetail(Idx).Used
        Case False
            HrDetail(Idx).MaxMin = Minute(ws.Cells(RowNo, TimeColNo))
            HrDetail(Idx).MinMin = Minute(ws.Cells(RowNo, TimeColNo))
            HrDetail(Idx).MaxMile = Val(ws.Cells(RowNo, MileColNo))
            HrDetail(Idx).MinMile = Val(ws.Cells(RowNo, MileColNo))
            HrDetail(Idx).Used = True
        Case True
            HrDetail(Idx).MaxMile = UpdateMax(HrDetail(Idx).MaxMile, Val(ws.Cells(RowNo, MileColNo)))
            HrDetail(Idx).MaxMin = UpdateMax(HrDetail(Idx).MaxMin, Minute(ws.Cells(RowNo, TimeColNo)))
            HrDetail(Idx).MinMile = UpdateMin(HrDetail(Idx).MinMile, Val(ws.Cells(RowNo, MileColNo)))
            HrDetail(Idx).MinMin = UpdateMin(HrDetail(Idx).MinMin, Minute(ws.Cells(RowNo, TimeColNo)))
    End Select
End Function
Function FindKeyIdx(ByVal Key As String, Rec() As typRec) As Integer
    Dim I As Integer
    
    For I = 1 To UBound(Rec)
        If Key = Rec(I).Key Then
            FindKeyIdx = I
            Exit Function
        End If
    Next I
    
    ReDim Preserve Rec(I)
    Rec(I).Key = Key
    
    'ReDim Rec(I).HrDetail(0)
    
    FindKeyIdx = I
End Function
Function UpdateMin(arrVal As Long, wsVal As Long) As Long
    If wsVal < arrVal Then
        UpdateMin = wsVal
    Else
        UpdateMin = arrVal
    End If
End Function
Function UpdateMax(arrVal As Long, wsVal As Long)
    If wsVal > arrVal Then
        UpdateMax = wsVal
    Else
        UpdateMax = arrVal
    End If
End Function
 
Upvote 0
Amazing how flawless and fast this script works.
It just ran through 20K lines in mere seconds.



Please do say so if you feel I'm over-asking here, but observing the output, I realize there is still another dimension to his problem.

If you process for instance this data:

[TABLE="width: 448"]
<tbody>[TR]
[TD="class: xl63, width: 64"]Datum[/TD]
[TD="class: xl64, width: 64"]TX start[/TD]
[TD="class: xl64, width: 64"]TX stop[/TD]
[TD="class: xl65, width: 64"]Ch[/TD]
[TD="class: xl65, width: 64"]WP_WAGEN_NUMMER[/TD]
[TD="class: xl65, width: 64"]INS_KILOMETERSTAND[/TD]
[TD="class: xl66, width: 64"]UIT_KILOMETERSTAND[/TD]
[/TR]
[TR]
[TD="class: xl67, align: right"]12-3-2012[/TD]
[TD="class: xl75, align: right"]16:30:00[/TD]
[TD="class: xl72, align: right"]23:45:00[/TD]
[TD="class: xl69, align: right"]5207[/TD]
[TD="align: right"]1[/TD]
[TD="class: xl69, align: right"]227350[/TD]
[TD="class: xl76, align: right"]227500[/TD]
[/TR]
[TR]
[TD="class: xl67, align: right"]12-3-2012[/TD]
[TD="class: xl68, align: right"]16:36:00[/TD]
[TD="class: xl68, align: right"]17:39:00[/TD]
[TD="class: xl69, align: right"]5207[/TD]
[TD="class: xl69, align: right"]1[/TD]
[TD="class: xl69, align: right"]227354[/TD]
[TD="class: xl70, align: right"]227379[/TD]
[/TR]
[TR]
[TD="class: xl71, align: right"]12-3-2012[/TD]
[TD="class: xl72, align: right"]16:36:00[/TD]
[TD="class: xl72, align: right"]17:35:00[/TD]
[TD="class: xl73, align: right"]5207[/TD]
[TD="class: xl73, align: right"]1[/TD]
[TD="class: xl73, align: right"]227354[/TD]
[TD="class: xl74, align: right"]227378[/TD]
[/TR]
[TR]
[TD="class: xl67, align: right"]12-3-2012[/TD]
[TD="class: xl68, align: right"]16:53:00[/TD]
[TD="class: xl68, align: right"]17:15:00[/TD]
[TD="class: xl69, align: right"]5207[/TD]
[TD="class: xl69, align: right"]1[/TD]
[TD="class: xl69, align: right"]227356[/TD]
[TD="class: xl70, align: right"]227367[/TD]
[/TR]
[TR]
[TD="class: xl71, align: right"]12-3-2012[/TD]
[TD="class: xl72, align: right"]16:59:00[/TD]
[TD="class: xl72, align: right"]17:29:00[/TD]
[TD="class: xl73, align: right"]5207[/TD]
[TD="class: xl73, align: right"]1[/TD]
[TD="class: xl73, align: right"]227357[/TD]
[TD="class: xl74, align: right"]227376[/TD]
[/TR]
[TR]
[TD="class: xl67, align: right"]12-3-2012[/TD]
[TD="class: xl68, align: right"]17:57:00[/TD]
[TD="class: xl68, align: right"]18:18:00[/TD]
[TD="class: xl69, align: right"]5207[/TD]
[TD="class: xl69, align: right"]1[/TD]
[TD="class: xl69, align: right"]227386[/TD]
[TD="class: xl70, align: right"]227394[/TD]
[/TR]
[TR]
[TD="class: xl71, align: right"]12-3-2012[/TD]
[TD="class: xl72, align: right"]18:11:00[/TD]
[TD="class: xl72, align: right"]18:30:00[/TD]
[TD="class: xl73, align: right"]5207[/TD]
[TD="class: xl73, align: right"]1[/TD]
[TD="class: xl73, align: right"]227391[/TD]
[TD="class: xl74, align: right"]227400[/TD]
[/TR]
[TR]
[TD="class: xl67, align: right"]12-3-2012[/TD]
[TD="class: xl68, align: right"]18:21:00[/TD]
[TD="class: xl68, align: right"]18:33:00[/TD]
[TD="class: xl69, align: right"]5207[/TD]
[TD="class: xl69, align: right"]1[/TD]
[TD="class: xl69, align: right"]227394[/TD]
[TD="class: xl70, align: right"]227400[/TD]
[/TR]
[TR]
[TD="class: xl71, align: right"]12-3-2012[/TD]
[TD="class: xl72, align: right"]18:39:00[/TD]
[TD="class: xl72, align: right"]18:50:00[/TD]
[TD="class: xl73, align: right"]5207[/TD]
[TD="class: xl73, align: right"]1[/TD]
[TD="class: xl73, align: right"]227401[/TD]
[TD="class: xl74, align: right"]227404[/TD]
[/TR]
[TR]
[TD="class: xl67, align: right"]12-3-2012[/TD]
[TD="class: xl68, align: right"]18:43:00[/TD]
[TD="class: xl68, align: right"]19:30:00[/TD]
[TD="class: xl69, align: right"]5207[/TD]
[TD="class: xl69, align: right"]1[/TD]
[TD="class: xl69, align: right"]227402[/TD]
[TD="class: xl70, align: right"]227422[/TD]
[/TR]
[TR]
[TD="class: xl71, align: right"]12-3-2012[/TD]
[TD="class: xl72, align: right"]19:00:00[/TD]
[TD="class: xl72, align: right"]19:35:00[/TD]
[TD="class: xl73, align: right"]5207[/TD]
[TD="class: xl73, align: right"]1[/TD]
[TD="class: xl73, align: right"]227408[/TD]
[TD="class: xl74, align: right"]227425[/TD]
[/TR]
[TR]
[TD="class: xl67, align: right"]12-3-2012[/TD]
[TD="class: xl68, align: right"]19:11:00[/TD]
[TD="class: xl68, align: right"]19:36:00[/TD]
[TD="class: xl69, align: right"]5207[/TD]
[TD="class: xl69, align: right"]1[/TD]
[TD="class: xl69, align: right"]227415[/TD]
[TD="class: xl70, align: right"]227425[/TD]
[/TR]
[TR]
[TD="class: xl71, align: right"]12-3-2012[/TD]
[TD="class: xl72, align: right"]19:20:00[/TD]
[TD="class: xl72, align: right"]19:49:00[/TD]
[TD="class: xl73, align: right"]5207[/TD]
[TD="class: xl73, align: right"]1[/TD]
[TD="class: xl73, align: right"]227418[/TD]
[TD="class: xl74, align: right"]227433[/TD]
[/TR]
[TR]
[TD="class: xl67, align: right"]12-3-2012[/TD]
[TD="class: xl68, align: right"]21:29:00[/TD]
[TD="class: xl68, align: right"]21:37:00[/TD]
[TD="class: xl69, align: right"]5207[/TD]
[TD="class: xl69, align: right"]1[/TD]
[TD="class: xl69, align: right"]227440[/TD]
[TD="class: xl70, align: right"]227442[/TD]
[/TR]
[TR]
[TD="class: xl71, align: right"]12-3-2012[/TD]
[TD="class: xl72, align: right"]21:51:00[/TD]
[TD="class: xl72, align: right"]22:14:00[/TD]
[TD="class: xl73, align: right"]5207[/TD]
[TD="class: xl73, align: right"]1[/TD]
[TD="class: xl73, align: right"]227449[/TD]
[TD="class: xl74, align: right"]227459[/TD]
[/TR]
[TR]
[TD="class: xl67, align: right"]12-3-2012[/TD]
[TD="class: xl68, align: right"]22:01:00[/TD]
[TD="class: xl68, align: right"]22:19:00[/TD]
[TD="class: xl69, align: right"]5207[/TD]
[TD="class: xl69, align: right"]1[/TD]
[TD="class: xl69, align: right"]227453[/TD]
[TD="class: xl70, align: right"]227460[/TD]
[/TR]
[TR]
[TD="class: xl71, align: right"]12-3-2012[/TD]
[TD="class: xl72, align: right"]23:20:00[/TD]
[TD="class: xl72, align: right"]23:38:00[/TD]
[TD="class: xl73, align: right"]5207[/TD]
[TD="class: xl73, align: right"]1[/TD]
[TD="class: xl73, align: right"]227473[/TD]
[TD="class: xl74, align: right"]227492[/TD]
[/TR]
</tbody>[/TABLE]

You will see that between 20:00 and 21:00 hour, no event was started or stopped.
This results of course in the fact that the code doesnt generate a time-bucket for 20:00-21:00.
However in this time-spam, 7 kilometers were travelled.

Can the code be modified even further to provide for this problem?
I realise this might result in an exponential growth in the amount of lines generated.
Also which driver ID should be associated?
Many other questions will certanly arise as well.


Perhaps something else would be helpful.
I happen to have another table which contains start and stop events of shifts, with associated time and mileage values.
These shifts encompass, contain, so to say, all the events which are in my original data. So within a shift, things happen a certain time and mileage values.

I have added such a line of data in the above example. (top line)
You see this line has the earliest start-time and the latest stop-time, as well as the lowest and the highest mileage value.


So the above in one sentence:
Do you think it might also be possible to let the script recognise the fact that (in the above example) it should also create the 20:00-21:00 line?
 
Upvote 0
Yes,

The data usually consists of many days, say a month.

Also shifts might run after midnight and events can also start before midnight and end after midnight.

Pretty complicated.
 
Upvote 0
If I look at the original data, You have one column for a Date and two columns for Times (One for Start Time and another for End Time) How do you represent a Event that start before mid night and ends the next day?

Here is some code that display the 4 miles incured during the 20:00 to 21:00 bin. The end result is still 150 miles

Code:
Option Explicit
Const DateCol As Integer = 1
Const StartTimeCol As Integer = 2
Const EndTimeCol As Integer = 3
Const DriverCol As Integer = 4
Const CarNoCol As Integer = 5
Const StartMileCol As Integer = 6
Const EndMileCol As Integer = 7
Type typDt_MilesRec
    Dt As Date
    Miles As Long
End Type
Type typMstRec
    Key As String
    DT_Miles() As typDt_MilesRec
End Type
Sub Process()
    Dim ws As Worksheet
    Dim ws3 As Worksheet
    
    Dim MstRec() As typMstRec
    Dim RowNo As Long
    Dim LastRow As Long
    
    Dim I As Long
    Dim Key As String
    Dim KeyIdx As Integer
    
    ReDim MstRec(0)
    
    Set ws = ThisWorkbook.Worksheets(1)
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For RowNo = 2 To LastRow
        If Len(Trim(ws.Cells(RowNo, StartTimeCol))) > 1 Then
            Key = Trim(ws.Cells(RowNo, DateCol)) & "~" & Trim(ws.Cells(RowNo, DriverCol)) & "~" & Trim(ws.Cells(RowNo, CarNoCol))
            KeyIdx = FindKeyIdx(Key, MstRec)
            
            I = UBound(MstRec(KeyIdx).DT_Miles) + 1
            ReDim Preserve MstRec(KeyIdx).DT_Miles(I)
            
            MstRec(KeyIdx).DT_Miles(I).Miles = Val(ws.Cells(RowNo, StartMileCol))
            MstRec(KeyIdx).DT_Miles(I).Dt = ws.Cells(RowNo, StartTimeCol)
            Call InsertRec(MstRec, KeyIdx)
            
            I = UBound(MstRec(KeyIdx).DT_Miles) + 1
            ReDim Preserve MstRec(KeyIdx).DT_Miles(I)
            
            MstRec(KeyIdx).DT_Miles(I).Miles = Val(ws.Cells(RowNo, EndMileCol))
            MstRec(KeyIdx).DT_Miles(I).Dt = ws.Cells(RowNo, EndTimeCol)
            Call InsertRec(MstRec, KeyIdx)
        End If
    Next RowNo
    
    Call OutputAll(MstRec)
    
    MsgBox "Complete", vbInformation
End Sub
Function InsertRec(Rec() As typMstRec, IDX As Integer)
    Dim I As Long
    Dim xRec As typDt_MilesRec
    Dim MaxIdx As Integer
    
    MaxIdx = UBound(Rec(IDX).DT_Miles)
    
    '*****  This function sorts the last record into the correct location
    For I = MaxIdx - 1 To 1 Step -1
        If Rec(IDX).DT_Miles(I).Dt > Rec(IDX).DT_Miles(I + 1).Dt Then
            xRec = Rec(IDX).DT_Miles(I + 1)
            Rec(IDX).DT_Miles(I + 1) = Rec(IDX).DT_Miles(I)
            Rec(IDX).DT_Miles(I) = xRec
        Else
            Exit Function
        End If
    Next I
End Function
Function OutputAll(MstRec() As typMstRec)
    Dim ws As Worksheet
    Dim RowNo  As Integer
    Dim KeyIdx As Integer
    
    Dim v As Variant
    Dim I As Integer
    
    Set ws = ThisWorkbook.Worksheets(2)
    ws.Cells.ClearContents
    RowNo = 1
    
    ws.Cells(RowNo, 1) = "Datum"
    ws.Cells(RowNo, 2) = "Ch"
    ws.Cells(RowNo, 3) = "WP_Wagen"
    ws.Cells(RowNo, 4) = "Hr"
    ws.Cells(RowNo, 5) = "Km"
    
    For KeyIdx = 1 To UBound(MstRec)
        Call OutputData(ws, MstRec(KeyIdx), MstRec(KeyIdx).Key)
        Debug.Print MstRec(KeyIdx).Key
    Next KeyIdx
End Function
Function OutputData(ws As Worksheet, MstRec As typMstRec, Key As String)
    Dim I As Integer
    Dim RowNo As Long
    
    Dim v As Variant
    Dim J As Integer
    
    Dim Perc As Single
    Dim tempMins As Integer
    Dim tempMiles As Long
    
    Dim ElapsedMins As Integer
    Dim ElapsedMiles As Long
    
    Dim StartTime As Date
    Dim EndTime As Date
    
    Dim BinIdx As Integer
    Dim StartHr As Integer
    Dim EndHr As Integer
    Dim HourDiff As Integer
    
    Dim MilesInHr(24) As Long
    
    RowNo = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row + 1
    
    For I = 2 To UBound(MstRec.DT_Miles)
        StartTime = MstRec.DT_Miles(I - 1).Dt
        EndTime = MstRec.DT_Miles(I).Dt
        ElapsedMiles = MstRec.DT_Miles(I).Miles - MstRec.DT_Miles(I - 1).Miles
        
        If ElapsedMiles > 0 Then
            ElapsedMins = DateDiff("n", MstRec.DT_Miles(I - 1).Dt, MstRec.DT_Miles(I).Dt)
            StartHr = Hour(MstRec.DT_Miles(I - 1).Dt)
            EndHr = Hour(MstRec.DT_Miles(I).Dt)
            HourDiff = EndHr - StartHr
            
            Select Case HourDiff
                Case 0
                    MilesInHr(StartHr) = MilesInHr(StartHr) + ElapsedMiles
                Case Else
                    '***** Determine fractional time for 1st hour
                    BinIdx = Hour(StartTime)
                    tempMins = DateDiff("n", StartTime, CDate(BinIdx + 1 & ":00:00"))
                    Perc = tempMins / ElapsedMins
                    MilesInHr(BinIdx) = MilesInHr(BinIdx) + (ElapsedMiles * Perc)
                
                    Perc = 60 / ElapsedMins
                    For BinIdx = Hour(StartTime) + 1 To Hour(EndTime) - 1
                        MilesInHr(BinIdx) = MilesInHr(BinIdx) + (ElapsedMiles * Perc)
                    Next BinIdx
                    
                    '***** Determine fractional time for Last hour
                    BinIdx = Hour(EndTime)
                    tempMins = DateDiff("n", CDate(BinIdx & ":00:00"), EndTime)
                    Perc = tempMins / ElapsedMins
                    MilesInHr(BinIdx) = MilesInHr(BinIdx) + (ElapsedMiles * Perc)
            End Select
        End If
    Next I
       
    v = Split(Key, "~")
    For I = 1 To 24
        If MilesInHr(I) > 0 Then
            ws.Cells(RowNo, 1) = CDate(v(0))
            ws.Cells(RowNo, 2) = v(1)
            ws.Cells(RowNo, 3) = v(2)
            ws.Cells(RowNo, 4) = I & ":00" & " ~ " & (I + 1) & ":00"
            ws.Cells(RowNo, "E") = MilesInHr(I)
            RowNo = RowNo + 1
        End If
    Next I
    
End Function
Function FindKeyIdx(ByVal Key As String, Rec() As typMstRec) As Integer
    Dim I As Integer
    
    For I = 1 To UBound(Rec)
        If Key = Rec(I).Key Then
            FindKeyIdx = I
            Exit Function
        End If
    Next I
    
    ReDim Preserve Rec(I)
    Rec(I).Key = Key
    
    ReDim Preserve Rec(I).DT_Miles(0)
    
    FindKeyIdx = I
End Function
 
Upvote 0
This is utterly briliant:
I will have to run some more data through the code, but so far the output is even more accurate then I would have hoped.


The date column is linked to the start time.
So if an event crosses midnight. The data associated with the stop time should be date+1.

A solution I used earlier in non vba approaches:
The rest of the data of the larger model works with time buckets that exceed midnight. So things that happen between 2400 and 0100 are in a bucket called '2400-2500'. Also the bucket 2500-2600 exists.
After that the next one is 0200-0300. Events that cross 2600 hour are extremely rare.

So in the PowerPivot model, I'll be relating the output to this "bucket-table":

[TABLE="width: 176"]
<tbody>[TR]
[TD]0200-0300[/TD]
[/TR]
[TR]
[TD]0300-0400[/TD]
[/TR]
[TR]
[TD]0400-0500[/TD]
[/TR]
[TR]
[TD]0500-0600[/TD]
[/TR]
[TR]
[TD]0600-0700[/TD]
[/TR]
[TR]
[TD]0700-0800[/TD]
[/TR]
[TR]
[TD]0800-0900[/TD]
[/TR]
[TR]
[TD]0900-1000[/TD]
[/TR]
[TR]
[TD]1000-1100[/TD]
[/TR]
[TR]
[TD]1100-1200[/TD]
[/TR]
[TR]
[TD]1200-1300[/TD]
[/TR]
[TR]
[TD]1300-1400[/TD]
[/TR]
[TR]
[TD]1400-1500[/TD]
[/TR]
[TR]
[TD]1500-1600[/TD]
[/TR]
[TR]
[TD]1600-1700[/TD]
[/TR]
[TR]
[TD]1700-1800[/TD]
[/TR]
[TR]
[TD]1800-1900[/TD]
[/TR]
[TR]
[TD]1900-2000[/TD]
[/TR]
[TR]
[TD]2000-2100[/TD]
[/TR]
[TR]
[TD]2100-2200[/TD]
[/TR]
[TR]
[TD]2200-2300[/TD]
[/TR]
[TR]
[TD]2300-2400[/TD]
[/TR]
[TR]
[TD]2400-2500[/TD]
[/TR]
[TR]
[TD]2500-2600[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Ok... Here is some improvement to the last version

If the Endtime < Starttime on the Source sheet, the application will assume that the endtime is the folloiwng day (Date listed in Col 1 + 1)

The Code will handle Date Transition correctly because it does all calulation of the combination of Date & Time rather than time alone.

All Dates and Times must be valid

Depending of the number of miles, there cound be some rounding errors becouse we are using whole (integer) rather than fractional numbers. Depending on you data, it may make since to fo with fractional miles
Let me know how this works for you
:)


Code:
Option Explicit
Const DateCol As Integer = 1
Const StartTimeCol As Integer = 2
Const EndTimeCol As Integer = 3
Const DriverCol As Integer = 4
Const CarNoCol As Integer = 5
Const StartMileCol As Integer = 6
Const EndMileCol As Integer = 7
Type typDt_MilesRec
    Dt As Date
    Miles As Long
End Type
Type typMstRec
    Key As String
    DT_Miles() As typDt_MilesRec
End Type
Type typBin
    Dt_Hr As Date
    Miles As Long
End Type
Sub Process()
    Dim ws As Worksheet
    Dim ws3 As Worksheet
    
    Dim MstRec() As typMstRec
    Dim RowNo As Long
    Dim LastRow As Long
    
    Dim I As Long
    Dim Key As String
    Dim KeyIdx As Integer
    
    Dim tempStartTime As Date
    
    ReDim MstRec(0)
    
    Set ws = ThisWorkbook.Worksheets(1)
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For RowNo = 2 To LastRow
        If Len(Trim(ws.Cells(RowNo, StartTimeCol))) > 1 Then
            Key = Trim(ws.Cells(RowNo, DriverCol)) & "~" & Trim(ws.Cells(RowNo, CarNoCol))
            KeyIdx = FindKeyIdx(Key, MstRec)
            
            I = UBound(MstRec(KeyIdx).DT_Miles) + 1
            ReDim Preserve MstRec(KeyIdx).DT_Miles(I)
            
            MstRec(KeyIdx).DT_Miles(I).Miles = Val(ws.Cells(RowNo, StartMileCol))
            MstRec(KeyIdx).DT_Miles(I).Dt = CDate(ws.Cells(RowNo, DateCol) & " " & CDate(ws.Cells(RowNo, StartTimeCol)))
            tempStartTime = MstRec(KeyIdx).DT_Miles(I).Dt
            Call InsertRec(MstRec, KeyIdx)
            
            I = UBound(MstRec(KeyIdx).DT_Miles) + 1
            ReDim Preserve MstRec(KeyIdx).DT_Miles(I)
            
            MstRec(KeyIdx).DT_Miles(I).Miles = Val(ws.Cells(RowNo, EndMileCol))
            MstRec(KeyIdx).DT_Miles(I).Dt = CDate(ws.Cells(RowNo, DateCol) & " " & CDate(ws.Cells(RowNo, EndTimeCol)))
            If tempStartTime > MstRec(KeyIdx).DT_Miles(I).Dt Then
                MstRec(KeyIdx).DT_Miles(I).Dt = DateAdd("D", 1, MstRec(KeyIdx).DT_Miles(I).Dt)
            End If
            Call InsertRec(MstRec, KeyIdx)
        End If
    Next RowNo
    
    Call OutputAll(MstRec)
    
    MsgBox "Complete", vbInformation
End Sub
Function InsertRec(Rec() As typMstRec, IDX As Integer)
    Dim I As Long
    Dim xRec As typDt_MilesRec
    Dim MaxIdx As Integer
    
    MaxIdx = UBound(Rec(IDX).DT_Miles)
    
    '*****  This function sorts the last record into the correct location
    For I = MaxIdx - 1 To 1 Step -1
        If Rec(IDX).DT_Miles(I).Dt > Rec(IDX).DT_Miles(I + 1).Dt Then
            xRec = Rec(IDX).DT_Miles(I + 1)
            Rec(IDX).DT_Miles(I + 1) = Rec(IDX).DT_Miles(I)
            Rec(IDX).DT_Miles(I) = xRec
        Else
            Exit Function
        End If
    Next I
End Function
Function OutputAll(MstRec() As typMstRec)
    Dim ws As Worksheet
    Dim RowNo  As Integer
    Dim KeyIdx As Integer
    
    Dim v As Variant
    Dim I As Integer
    
    Set ws = ThisWorkbook.Worksheets(2)
    ws.Cells.ClearContents
    RowNo = 1
    
    ws.Cells(RowNo, 1) = "Datum"
    ws.Cells(RowNo, 2) = "Ch"
    ws.Cells(RowNo, 3) = "WP_Wagen"
    ws.Cells(RowNo, 4) = "Hr"
    ws.Cells(RowNo, 5) = "Km"
    
    For KeyIdx = 1 To UBound(MstRec)
        Call OutputData(ws, MstRec(KeyIdx), MstRec(KeyIdx).Key)
        Debug.Print MstRec(KeyIdx).Key
    Next KeyIdx
End Function
Function OutputData(ws As Worksheet, MstRec As typMstRec, Key As String)
    Dim I As Integer
    Dim RowNo As Long
    
    Dim v As Variant
    Dim J As Integer
    
    Dim Perc As Single
    Dim tempMins As Integer
    Dim tempMiles As Long
    
    Dim ElapsedMins As Integer
    Dim ElapsedMiles As Long
    
    Dim StartTime As Date
    Dim EndTime As Date
    
    Dim BinIdx As Integer
    Dim StartHr As Integer
    Dim EndHr As Integer
    Dim HourDiff As Integer
    
    Dim tempTime As Date
    
    Dim arrBin() As typBin
    ReDim arrBin(0)
    
    RowNo = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row + 1
    
    For I = 2 To UBound(MstRec.DT_Miles)
        StartTime = MstRec.DT_Miles(I - 1).Dt
        EndTime = MstRec.DT_Miles(I).Dt
        ElapsedMiles = MstRec.DT_Miles(I).Miles - MstRec.DT_Miles(I - 1).Miles
        
        If ElapsedMiles > 0 Then
            ElapsedMins = DateDiff("n", MstRec.DT_Miles(I - 1).Dt, MstRec.DT_Miles(I).Dt)
            HourDiff = DateDiff("h", StartTime, EndTime)
            Select Case HourDiff
                Case 0
                    BinIdx = FindBin_DT_HR(StartTime, arrBin)
                    arrBin(BinIdx).Miles = arrBin(BinIdx).Miles + ElapsedMiles
                Case Else
                    '***** Determine fractional time for 1st hour
                    BinIdx = FindBin_DT_HR(StartTime, arrBin)
                    tempTime = CDate(Format(StartTime, "MM/DD/YY HH:00:00"))
                    tempMins = DateDiff("n", StartTime, DateAdd("h", 1, tempTime))
                    Perc = tempMins / ElapsedMins
                    arrBin(BinIdx).Miles = arrBin(BinIdx).Miles + (ElapsedMiles * Perc)
                    'Determine Full hour mileage between Start and End Time
                    Perc = 60 / ElapsedMins
                    tempTime = DateAdd("h", 1, StartTime)
                    Do While Hour(tempTime) < Hour(EndTime)
                        BinIdx = FindBin_DT_HR(tempTime, arrBin)
                        arrBin(BinIdx).Miles = arrBin(BinIdx).Miles + (ElapsedMiles * Perc)
                        tempTime = DateAdd("h", 1, tempTime)
                    Loop
                    
                    '***** Determine fractional time for Last hour
                    BinIdx = FindBin_DT_HR(EndTime, arrBin)
                    tempTime = CDate(Format(EndTime, "MM/DD/YY HH:00:00"))
                    tempMins = DateDiff("n", tempTime, EndTime)
                    Perc = tempMins / ElapsedMins
                    arrBin(BinIdx).Miles = arrBin(BinIdx).Miles + (ElapsedMiles * Perc)
            End Select
        End If
    Next I
       
    v = Split(Key, "~")
    For I = 1 To UBound(arrBin)
        ws.Cells(RowNo, 1) = CDate(Format(arrBin(I).Dt_Hr, "MM/DD/YY"))
        If UBound(v) >= 1 Then
            ws.Cells(RowNo, 2) = v(0)
            ws.Cells(RowNo, 3) = v(1)
        End If
        ws.Cells(RowNo, 4) = Format(arrBin(I).Dt_Hr, "HH:MM") & " ~ " & Format(arrBin(I).Dt_Hr, "HH:59")
        ws.Cells(RowNo, "E") = arrBin(I).Miles
        RowNo = RowNo + 1
    Next I
    
End Function
Function FindBin_DT_HR(ByVal Dt As Date, Rec() As typBin) As Integer
    Dim I As Integer
    Dim tempDT As Date
    
    tempDT = Format(Dt, "MM/DD/YY HH:00:00")
    
    For I = 1 To UBound(Rec)
        If tempDT = Rec(I).Dt_Hr Then
            FindBin_DT_HR = I
            Exit Function
        End If
    Next I
    
    ReDim Preserve Rec(I)
    Rec(I).Dt_Hr = tempDT
    
    FindBin_DT_HR = I
End Function
Function FindKeyIdx(ByVal Key As String, Rec() As typMstRec) As Integer
    Dim I As Integer
    
    For I = 1 To UBound(Rec)
        If Key = Rec(I).Key Then
            FindKeyIdx = I
            Exit Function
        End If
    Next I
    
    ReDim Preserve Rec(I)
    Rec(I).Key = Key
    
    ReDim Preserve Rec(I).DT_Miles(0)
    
    FindKeyIdx = I
End Function
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,931
Messages
6,175,465
Members
452,646
Latest member
tudou

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