'This application opens a file supplied from a
'fuel supplier
'When the wokrbook is opened a form is displayed
Sub Auto_Open()
UserForm1.Show
End Sub
'open file code
Private Sub cmdOpenFile_Click()
Dim OpenFile As String
' CancelError is True.
On Error GoTo ErrHandler
CommonDialog1.Filter = "Text Files (*.txt)|*.txt"
' Specify default filter.
CommonDialog1.FilterIndex = 2
' Display the Open dialog box.
CommonDialog1.ShowOpen
' Call the open file procedure.
On Error GoTo ErrHandler
OpenFile = CommonDialog1.FileName
If OpenFile = "" Then
GoTo ErrHandler
End If
ThisWorkbook.FuelLoad OpenFile
ThisWorkbook.Total
Exit Sub
ErrHandler:
' User pressed Cancel button.
Exit Sub
End Sub
'The foollowing open the text file then
'format and present the data
Option Explicit
Dim xla As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim ws2 As Excel.Worksheet
Dim ws3 As Excel.Worksheet
Sub Total()
Dim Fuel_Type As Long
Dim Liters As Double
Dim ltrs As Double
Dim Amt_Ex_GST As Double
Dim GST As Double
Dim Amt As Double
Dim Tot_Liters As Double
Dim Tot_Amt_Inc_GST As Double
Dim Amt_Inc_GST As Double
Dim Tot_GST As Double
Dim Tot_Amt As Double
Dim UnitPrice As Double
Dim Lts As Double
Dim i, t As Long
Dim Fee, Tot_Fee As Double
Dim Gross, Tot_Gross As Double
Dim GrossAmt As Double
Dim col As Integer
Dim GSTAmt As Double
Dim sFuelType As String
Dim LastRow As Integer
Dim SaveRego, SaveAsset As String
Dim SaveODO As Long
Dim SaveDate As String
Set xla = Application
Set wb = xla.ActiveWorkbook
'Add Worksheet
xla.ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Liters = 0
Tot_Liters = 0
Amt_Inc_GST = 0
Tot_Amt_Inc_GST = 0
GST = 0
Tot_GST = 0
Amt = 0
Tot_Amt = 0
Gross = 0
Tot_Gross = 0
Fee = 0
Tot_Fee = 0
Set ws = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
i = 2
t = 1
ws2.Cells(t, 1).Value = "Fuel Type"
ws2.Cells(t, 2).Value = "Liters"
ws2.Cells(t, 3).Value = "Amt (ex GST)"
ws2.Cells(t, 4).Value = "GST"
ws2.Cells(t, 5).Value = "Amt (inc GST)"
ws2.Cells(t, 6).Value = "Fee"
ws2.Cells(t, 7).Value = "Gross Amt"
t = 2
Fuel_Type = ws.Cells(2, 8).Value
Do While ws.Cells(i, 1).Value > 0
Do While Fuel_Type = ws.Cells(i, 8).Value And ws.Cells(i, 1).Value > 0
ltrs = ws.Cells(i, 11).Value / 100
UnitPrice = ws.Cells(i, 10).Value / 10000
GSTAmt = ws.Cells(i, 31) / 100
GrossAmt = ws.Cells(i, 12).Value / 100
Liters = Liters + ltrs
GST = GST + GSTAmt
Fee = Fee + (ws.Cells(i, 13).Value / 100)
Gross = Gross + GrossAmt
i = i + 1
Loop
Tot_Liters = Tot_Liters + Liters
Amt = Gross - GST - Fee
Tot_Amt = Tot_Amt + Amt
Tot_GST = Tot_GST + GST
Amt_Inc_GST = Gross - Fee
Tot_Amt_Inc_GST = Tot_Amt_Inc_GST + Amt_Inc_GST
Tot_Fee = Tot_Fee + Fee
Tot_Gross = Tot_Gross + Gross
t = t + 1
sFuelType = "Type " + Format(Fuel_Type, "###")
Select Case Fuel_Type ' Evaluate Fuel Type.
Case 5
sFuelType = "Unleaded"
Case 6
sFuelType = "LS Diesel"
Case 17
sFuelType = "BP ULS Diesel"
Case 19
sFuelType = "ULP + 10% Ethanol"
Case 23
sFuelType = "LS Diesel"
End Select
ws2.Cells(t, 1).Value = sFuelType
ws2.Cells(t, 2).Value = Liters 'Liters
ws2.Cells(t, 3).Value = Amt 'Amount ex GST
ws2.Cells(t, 4).Value = GST 'GST
ws2.Cells(t, 5).Value = Amt_Inc_GST 'Amoutn inc GST
ws2.Cells(t, 6).Value = Fee 'Fee
ws2.Cells(t, 7).Value = Gross 'Gross Amount
Fuel_Type = ws.Cells(i, 8).Value
Liters = 0
Amt_Inc_GST = 0
GST = 0
Amt = 0
Fee = 0
Gross = 0
Loop
t = t + 2
ws2.Cells(t, 1).Value = "Total"
ws2.Cells(t, 2).Value = Tot_Liters
ws2.Cells(t, 3).Value = Tot_Amt
ws2.Cells(t, 4).Value = Tot_GST
ws2.Cells(t, 5).Value = Tot_Amt_Inc_GST
ws2.Cells(t, 6).Value = Tot_Fee
ws2.Cells(t, 7).Value = Tot_Gross
'For col = 1 To 7
' wb.ActiveSheet.Columns(col).EntireColumn.AutoFit
'Next col
ws2.Columns("A:G").Select
ws2.Range("G1").Activate
ws2.Columns("A:G").EntireColumn.AutoFit
ws2.Columns("C:G").Select
Selection.Style = "Currency"
ws2.Range(ws2.Cells(t, 1), ws2.Cells(t, 7)).Select
Selection.Font.Bold = True
ws2.Rows("1:1").Select
Selection.Font.Bold = True
' Now Create Odometer Max Readings Report
LastRow = i - 1
ws.Select
ws.Range(Cells(2, 1), Cells(LastRow, 48)).Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("I2") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
xla.ActiveWorkbook.Worksheets.Add After:=Worksheets(1)
Set ws3 = xla.ActiveWorkbook.Sheets(2)
i = 2
SaveODO = ws.Cells(i, 9).Value
SaveRego = ws.Cells(i, 2).Value
SaveAsset = ws.Cells(i, 35).Value
SaveDate = ws.Cells(i, 4).Value
t = 1
ws3.Cells(t, 1).Value = "Rego"
ws3.Cells(t, 2).Value = "Asset"
ws3.Cells(t, 3).Value = "Date"
ws3.Cells(t, 4).Value = "Last ODO"
t = 2
Do While ws.Cells(i, 1).Value > 0
Do While SaveRego = ws.Cells(i, 2).Value And ws.Cells(i, 1).Value > 0
SaveODO = ws.Cells(i, 9).Value
SaveDate = ws.Cells(i, 4).Value
i = i + 1
Loop
t = t + 1
ws3.Cells(t, 1).Value = SaveRego
ws3.Cells(t, 2).Value = SaveAsset
ws3.Cells(t, 3).Value = SaveDate
ws3.Cells(t, 4).Value = SaveODO
SaveRego = ws.Cells(i, 2).Value
SaveAsset = ws.Cells(i, 35).Value
Loop
t = t + 1
'ws3.Cells(t, 1).Value = SaveRego
'ws3.Cells(t, 2).Value = SaveAsset
'ws3.Cells(t, 3).Value = SaveODO
ws3.Columns("C:C").Select
Selection.NumberFormat = "dd/mm/yyyy"
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.ColumnWidth = 10.44
ws3.Columns("A:B").Select
ws3.Range("B1").Activate
Selection.ColumnWidth = 8.78
ws3.Columns("D:D").Select
Selection.ColumnWidth = 10.44
ws3.Columns("D:D").Select
Selection.Style = "Comma"
Selection.NumberFormat = "_-* #,##0.0_-;-* #,##0.0_-;_-* ""-""??_-;_-@_-"
Selection.NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
ws3.Columns("A:B").Select
ws3.Range("B1").Activate
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
ws3.Range("A1").Select
ws3.Select
ws3.Name = "ODO Readings"
ws2.Select
ws2.Name = "Fuel Totals"
xla.DisplayAlerts = False
wb.SaveAs FileName:="C:\TEMP\BPData.xls", FileFormat:=xlWorkbookNormal
xla.DisplayAlerts = True
End Sub
Sub FuelLoad(FileName As String)
'
' FuelLoad Macro
' Macro by Tody 7/03/2003
'
Dim r As Integer
'
Workbooks.OpenText FileName:=FileName, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 2), Array( _
3, 2), Array(4, 1), Array(5, 2), Array(6, 1), Array(7, 1), Array(8, 2), Array(9, 1), Array(10 _
, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 2), Array(15, 1), Array(16, 2), _
Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 2), Array(21, 1), Array(22, 1), Array( _
23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), _
Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 2), Array(34, 1), Array(35, 2), Array( _
36, 1), Array(37, 2), Array(38, 2), Array(39, 1), Array(40, 2), Array(41, 1), Array(42, 1))
Columns("A:AP").Select
Columns("A:AP").EntireColumn.AutoFit
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Columns("A:A").ColumnWidth = 6.56
ActiveCell.FormulaR1C1 = "Site"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Rego"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Card_no"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Site"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Time"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Receipt"
Range("H1").Select
Columns("G:G").ColumnWidth = 7.22
Columns("H:H").ColumnWidth = 8.89
ActiveCell.FormulaR1C1 = "Fuel_type"
Range("I1").Select
ActiveCell.FormulaR1C1 = "ODO"
Range("J1").Select
Columns("J:J").ColumnWidth = 9.89
Range("J1").Select
ActiveCell.FormulaR1C1 = "Unit_Price"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Liters"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Fee"
Range("N1").Select
Columns("M:M").ColumnWidth = 4.11
Columns("N:N").ColumnWidth = 14.22
Range("N1").Select
ActiveCell.FormulaR1C1 = "Dept"
Range("O1").Select
Columns("O:O").ColumnWidth = 5.33
Range("O1").Select
ActiveCell.FormulaR1C1 = "Duty"
Range("P1").Select
ActiveCell.FormulaR1C1 = "Site_Addr"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "Fleet_Id"
Range("R1").Select
ActiveCell.FormulaR1C1 = "Driver_id"
Range("S1").Select
ActiveCell.FormulaR1C1 = "Vehicle_id"
Range("T1").Select
ActiveCell.FormulaR1C1 = "ISP_Ac_Ref"
Range("U1").Select
ActiveCell.FormulaR1C1 = "Attn_Flag"
Range("U2").Select
Columns("U:U").ColumnWidth = 7.11
Range("V1").Select
Columns("U:U").ColumnWidth = 8.22
Range("V1").Select
ActiveCell.FormulaR1C1 = "Base_Price"
Range("V2").Select
Columns("V:V").ColumnWidth = 10.22
Range("W1").Select
ActiveCell.FormulaR1C1 = "Excise_Price"
Range("W2").Select
Columns("W:W").ColumnWidth = 10.44
Range("X1").Select
Columns("X:X").ColumnWidth = 9.44
Columns("Y:Y").ColumnWidth = 7.89
Range("X1").Select
ActiveCell.FormulaR1C1 = "State_Levy"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "Franchise"
Range("Z1").Select
ActiveCell.FormulaR1C1 = "Freight"
Range("AA1").Select
Columns("AA:AA").ColumnWidth = 7.33
Range("AA1").Select
ActiveCell.FormulaR1C1 = "Fr_Sub"
Range("AB1").Select
Columns("AB:AB").ColumnWidth = 7
Range("AB1").Select
ActiveCell.FormulaR1C1 = "Card_Diff"
Range("AC1").Select
Columns("AB:AB").ColumnWidth = 8.33
Columns("AC:AC").ColumnWidth = 6.56
ActiveCell.FormulaR1C1 = "Surcharge"
Range("AD1").Select
Columns("AC:AC").ColumnWidth = 7.67
Range("AD1").Select
Columns("AC:AC").ColumnWidth = 9
Range("AD1").Select
ActiveCell.FormulaR1C1 = "Discount"
Range("AE1").Select
Columns("AE:AE").ColumnWidth = 9.44
Range("AE1").Select
ActiveCell.FormulaR1C1 = "GST_Amt"
Range("AF1").Select
ActiveCell.FormulaR1C1 = "Pump_Price"
Range("AF2").Select
Columns("AF:AF").ColumnWidth = 10.11
Columns("AG:AG").ColumnWidth = 8.33
Range("AG1").Select
ActiveCell.FormulaR1C1 = "Merto_Country"
Range("AG2").Select
Columns("AG:AG").ColumnWidth = 11.44
ActiveWindow.SmallScroll ToRight:=4
Columns("AH:AH").ColumnWidth = 7.56
Range("AH1").Select
ActiveCell.FormulaR1C1 = "State"
Range("AI1").Select
ActiveCell.FormulaR1C1 = "Cost_Centre"
Range("AI2").Select
Columns("AI:AI").ColumnWidth = 10.22
Columns("AJ:AJ").ColumnWidth = 14.67
Range("AJ1").Select
ActiveCell.FormulaR1C1 = "Tran_No"
Range("AJ2").Select
Columns("AJ:AJ").ColumnWidth = 8.11
ActiveWindow.SmallScroll ToRight:=4
Range("AK1").Select
ActiveCell.FormulaR1C1 = "Source"
Range("AK2").Select
Columns("AK:AK").ColumnWidth = 5.89
Columns("AL:AL").ColumnWidth = 5.89
Range("AL1").Select
ActiveCell.FormulaR1C1 = "Coll"
Range("AM1").Select
ActiveCell.FormulaR1C1 = "Order"
Range("AN1").Select
ActiveCell.FormulaR1C1 = "Pricing_mthd"
Range("AN1").Select
ActiveCell.FormulaR1C1 = "Pricing_Mthd"
Range("AN2").Select
Columns("AN:AN").ColumnWidth = 10.44
Range("AO1").Select
ActiveCell.FormulaR1C1 = "Tran_Fee"
Range("AO2").Select
Columns("AO:AO").ColumnWidth = 7.33
Range("AP1").Select
ActiveCell.FormulaR1C1 = "Sales_Grant"
Range("AP2").Select
Columns("AP:AP").ColumnWidth = 10.56
r = 2
Do While Cells(r, 1).Value > 0
r = r + 1
Loop
Range(Cells(2, 1), Cells(r - 1, 48)).Select
' Debug.Print Format(Cells(r, 1).Value, "###.##0.00")
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Rows("1:1").Select
Selection.Font.Bold = True
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A2").Select
End Sub