Fleet Fuel Tracking

Lazyh0rse

New Member
Joined
Nov 7, 2018
Messages
8
Hi, I'm a first timer out of dark Africa

I'm trying to track fuel usage for a small fleet.
My issue is how to calculate the distance traveled between dates on a specific vehicle.
Any help would be much appreciated.


Vehicle IDDate ODO MeterDistance kmLiters - DepotResult
Truck12018/10/0114500 1710,00
Truck32018/10/0132410 1640,00
Truck22018/10/0220350 3330,00
Truck22018/10/1320740 1600,00
Truck12018/10/1514800 1430,00
Truck32018/10/1932890 1780,00
Truck32018/10/1933450 2430,00
Truck12018/10/2115550 3850,00
Truck22018/10/2221570 3700,00
Truck12018/10/2515940 1760,00
Truck32018/10/2633980 2260,00
Truck22018/10/2721980 1850,00

<colgroup><col span="2"><col><col><col><col></colgroup><tbody>
</tbody>
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
in a form , put 2 text boxes for the dates; txtStartDate, txtEndDate
a 3rd text box can hold the calc:

txtMiles = Dmax("[Miles]","table","[DAte]<=" & me.txtEndDate & "'") - Dmin("[Miles]","table","[DAte]>=" & me.txtStartDate & "'")
 
Upvote 0
Thanks for the reply, the only worst than asking for help is not understanding the answer.

Sorry I probably did not ask the question in the right way. Maybe it will help if I give a bit more info.

I have 13000 rows of info similar to the info in the attached example.
There are 25 trucks and the records go back to 2013.
Every time a truck fills up with diesel a new row is created.

So in my mind I need a formula in column D that refers to the vehicle ID, establish the previous ODO Meter reading for that vehicle and then subtract that from the ODO Meter reading that was just entered.
 
Upvote 0
.
Paste in a module :

Code:
Option Explicit
Sub CreateSheets()


    Dim Cell    As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet


        Set RngBeg = Worksheets("Master").Range("A2")
        Set RngEnd = Worksheets("Master").Cells(Rows.Count, "A").End(xlUp)


        ' Exit if the list is empty.
        If RngEnd.Row < RngBeg.Row Then Exit Sub
Application.ScreenUpdating = False
        For Each Cell In Worksheets("Master").Range(RngBeg, RngEnd)
            On Error Resume Next
                ' No error means the worksheet exists.
                Set Wks = Worksheets(Cell.Value)


                ' Add a new worksheet and name it.
                If Err <> 0 Then
                    Set Wks = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                    Wks.Name = Cell.Value
                End If
            On Error GoTo 0
        Next Cell
Application.ScreenUpdating = True
MakeHeaders
End Sub


Sub MakeHeaders()
Dim srcSheet As String
Dim dst As Integer
srcSheet = "Master"
Application.ScreenUpdating = False
For dst = 1 To Sheets.Count
    If Sheets(dst).Name <> srcSheet Then
    Sheets(srcSheet).Rows("1:1").Copy
    Sheets(dst).Activate
    Sheets(dst).Range("A1").PasteSpecial xlPasteValues
    Sheets(dst).Range("A1:F1").Font.Bold = True
    Sheets(dst).Range("A1").Select
    End If
Next
Application.ScreenUpdating = True
CopyData
End Sub


Sub CopyData()
Application.ScreenUpdating = False
Dim i As Long
Dim lastRow As Long
On Error GoTo M
lastRow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Dim ans As String
    For i = 2 To lastRow
    ans = Sheets("Master").Cells(i, 1).Value
        Sheets("Master").Rows(i).Copy Sheets(ans).Rows(Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1)
        Sheets(ans).Range("D3").Formula = "=SUM(C3-C2)"
        Sheets(ans).Columns("A:I").AutoFit
    Next
   


Sheets("Master").Activate
Sheets("Master").Range("A1").Select
Application.ScreenUpdating = True


dragformula


Exit Sub


M:
MsgBox "No such sheet as  " & ans & " exist"
Application.ScreenUpdating = True


End Sub


'paste this in Routine Module
Sub dragformula()
Dim lastRow As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Application.ScreenUpdating = False




For Each ws In wb.Worksheets
    If ws.Name <> "Master" Then
    lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row


    ws.Range("D3:D" & lastRow).FillDown
       
    End If
Next ws
Application.ScreenUpdating = True


SortSheetsTabName


End Sub


Sub SortSheetsTabName()
    Application.ScreenUpdating = False
    Dim iSheets%, i%, j%
    Dim ws As Worksheet


    iSheets = Sheets.Count
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Master" Then
        For i = 1 To iSheets - 1
            For j = i + 1 To iSheets
            
                If Sheets(j).Name < Sheets(i).Name Then
                    Sheets(j).Move before:=Sheets(i)
                End If
           
            Next j
        Next i
        End If
    Next
    Sheets("Master").Activate
    Sheets("Master").Range("A1").Select
    Application.ScreenUpdating = True
End Sub

Download workbook : https://www.amazon.com/clouddrive/share/fqsb8q0cQ4qPJpOIKkcPDcVYmkcwEAOAinC2IdMv4Ir
 
Upvote 0
.
Just continue adding data to the MASTER sheet.

Then click the button. It will do what you want automatically.

I made a slight edit to the code. Please change the existing macro ( CreateSheets ) for that shown below:

Code:
Option Explicit
Sub CreateSheets()


    Dim Cell    As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet


        Set RngBeg = Worksheets("Master").Range("A2")
        Set RngEnd = Worksheets("Master").Cells(Rows.Count, "A").End(xlUp)


        ' Exit if the list is empty.
        If RngEnd.Row < RngBeg.Row Then Exit Sub
Application.ScreenUpdating = False


        For Each ws In wb.Worksheets
            If ws.Name <> "Master" Then
                ws.UsedRange.ClearContents
            End If
        Next
        
        For Each Cell In Worksheets("Master").Range(RngBeg, RngEnd)
            On Error Resume Next
                ' No error means the worksheet exists.
                Set Wks = Worksheets(Cell.Value)


                ' Add a new worksheet and name it.
                If Err <> 0 Then
                    Set Wks = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                    Wks.Name = Cell.Value
                End If
            On Error GoTo 0
        Next Cell
Application.ScreenUpdating = True
MakeHeaders
End Sub


This portion of the macro :

For Each ws In wb.Worksheets
If ws.Name <> "Master" Then
ws.UsedRange.ClearContents
End If
Next

Will clear the existing TRUCk sheets each time you add new data and click the RUN button. If you do not delete the old data on the MASTER sheet,
the newly created sheets will include all of the old data plus the new data.
 
Upvote 0
Thanks, it seems that I do not have the skill to make that change:)
Would it be possible to make the change in workbook on your amazon drive?
 
Upvote 0
How about


Excel 2013/2016
ABCDEF
1Vehicle IDDateODO MeterDistance kmLiters - DepotResult
2Truck101/10/201814500145001710,00
3Truck301/10/201832410324101640,00
4Truck202/10/201820350203503330,00
5Truck213/10/2018207403901600,00
6Truck115/10/2018148003001430,00
7Truck319/10/2018328904801780,00
8Truck319/10/2018334505602430,00
9Truck121/10/2018155507503850,00
10Truck222/10/2018215708303700,00
11Truck125/10/2018159403901760,00
12Truck326/10/2018339805302260,00
13Truck227/10/2018219804101850,00
New
Cell Formulas
RangeFormula
D2{=IF(COUNTIF(A$2:A2,A2)=1,C2,C2-SMALL(IF(A$2:A$13=A2,C$2:C$13),COUNTIF(A$2:A2,A2)-1))}
Press CTRL+SHIFT+ENTER to enter array formulas.
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,037
Members
448,543
Latest member
MartinLarkin

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