Count Number of Days Each Car was Driven

[ben_b]

I am trying to count the number of days each car was driven (in Excel 2010). The problem is that the trip log for multiple cars is integrated together in the same sheet. So for each trip it indicates the car driven and the date range the car was driven for. Additionally some of the date ranges overlap like when the car was returned by someone and then checked out to someone else on the same day, it should only count that day once. How can I count the number of days each car was driven?

 

[Ruddles]

Welcome to the forum!

Without being able to see your data, and in the absence of a detailed description of where it is and what it looks like, I think the closest I can get to being able to describe a step-by-step solution is to say: either use some worksheet formulae or, if that's not possible, write some VBA code to do the job.

If you can post a representative sample of your data, that would give us more to go on. Place borders around the worksheets cells, select a small font such as 8pt, then copy-and-paste directly into a message.

 

[ben_b]

Unfortunately copying and posting a table into this forum isn't doing any good so I have uploaded my excel file to http://dl.dropbox.com/u/1487606/test.xlsx.

 

[Ruddles]

Apologies, it looks like the firewall at work yesterday was blocking the image of your worksheet - it wasn't appearing on my screen at all.

I'm about to go out but I shall take a look at your worksheet later today.

 

[Ruddles]

Before I go much further: is a VBA solution acceptable? I can't see any other way of doing this.

Is the entry in row 10 a typo: May should be July?

 

[Ruddles]

Okay, try this: in a copy of your workbook, create a new general code module and paste this code into it. The way it works is: it creates a 'flat file' with each of the trips expanded so that each day is on a separate row; it deletes duplicate rows (where a car is used for separate trips on the same day); and then it makes a pivot table.

Assumptions are: your source data is in Sheet1; Sheet2, if it already exists, is available to take the output data. Change the bits in red if you want to use different sheet names. The code doesn't use your trip length field: it makes up its own mind what each trip length is by looking at the dates.

Try it and see how it goes. Let me know if you encounter any problems.

[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub CreatePivotTable()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Const SourceData As String = "[COLOR=red]Sheet1[/COLOR]"
  Const OutputData As String = "[COLOR=red]Sheet2[/COLOR]"
  Const PivotTablename As String = "MyPivotTable"
  
  Dim sws As Worksheet
  Dim tws As Worksheet
  Dim iLastRow As Long
  Dim iRow As Long
  Dim iNextRow As Long
  Dim iDate As Long
  Dim objPivotItem As PivotItem
  
  Set sws = ThisWorkbook.Sheets(SourceData)
  
  On Error Resume Next
  Set tws = ThisWorkbook.Sheets(OutputData)
  If Not tws Is Nothing Then
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(OutputData).Delete
    Application.DisplayAlerts = False
  End If
  On Error GoTo 0
  ThisWorkbook.Worksheets.Add After:=sws
  ActiveSheet.Name = OutputData
  Set tws = ThisWorkbook.Sheets(OutputData)
  
  tws.Range("A1") = "trip date"
  tws.Range("B1") = "car"
  
[COLOR=green]  ' pass 1: expand data - each trip is expanded to a series of single day trips
[/COLOR]  iLastRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
  iNextRow = 1
  For iRow = 2 To iLastRow
    For iDate = sws.Cells(iRow, "A").Value To sws.Cells(iRow, "B").Value
      iNextRow = iNextRow + 1
      tws.Cells(iNextRow, "A") = iDate
      tws.Cells(iNextRow, "A").NumberFormat = "d/m/yyyy"
      tws.Cells(iNextRow, "B") = sws.Cells(iRow, "C").Value
    Next iDate
  Next iRow
  
[COLOR=green]  ' pass 2: sort data - so we can dedupe it next
[/COLOR]  iLastRow = tws.Cells(tws.Rows.Count, "A").End(xlUp).Row
  With tws.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("B2:B" & iLastRow), SortOn:=xlSortOnValues, _
      Order:=xlAscending, DataOption:=xlSortNormal
    .SortFields.Add Key:=Range("A2:A" & iLastRow), SortOn:=xlSortOnValues, _
      Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("A2:B" & iLastRow)
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys][COLOR=green]  ' pass 3: dedupe data
[/COLOR]  For iRow = iLastRow - 1 To 2 Step -1
    If tws.Cells(iRow, "B").Value = tws.Cells(iRow + 1, "B").Value Then
      If tws.Cells(iRow, "A").Value = tws.Cells(iRow + 1, "A").Value Then
        tws.Rows(iRow + 1).EntireRow.Delete
      End If
    End If
  Next iRow
    
[COLOR=green]  ' pass 4: make pivot table
[/COLOR][COLOR=#008000][COLOR=black]  iLastRow = tws.Cells(tws.Rows.Count, "A").End(xlUp).Row
  ThisWorkbook.PivotCaches.Create( _
      SourceType:=xlDatabase, SourceData:="Sheet2!R1C1:R" & iLastRow & "C2", _
      Version:=xlPivotTableVersion12).CreatePivotTable _
      TableDestination:=OutputData & "!R1C4", TableName:=PivotTablename, _
      DefaultVersion:=xlPivotTableVersion12
  tws.PivotTables(PivotTablename).AddDataField _
      tws.PivotTables(PivotTablename).PivotFields(tws.Range[/COLOR][COLOR=black]("B1").Value), _
      "Trips/car", xlCount
  With tws.PivotTables(PivotTablename).PivotFields(tws.Range("B1").Value)
    .Orientation = xlRowField
    .Position = 1
  End With
  tws.Range("D1") = "Cars"
  With tws.PivotTables(PivotTablename).PivotFields(tws.Range("A1").Value)
    .Orientation = xlRowField
    .Position = 2
[/COLOR] [/COLOR][COLOR=black] End With
  
[COLOR=green]  ' hide details per car - comment this out to show details per car
[/COLOR]  With tws.PivotTables(PivotTablename).PivotFields(tws.Range("B1").Value)
    For Each objPivotItem In .PivotItems
      objPivotItem.ShowDetail = False
    Next objPivotItem
  End With
    
End Sub[/COLOR][/FONT]