KEMBAR78
For Adding On Center View | PDF | Vehicle Technology | Motor Vehicle
Scribd
Upload
35 views3 pages

For Adding On Center View

The document defines macros to log vehicle entry and exit times in a spreadsheet. Keyboard shortcuts are assigned to call macros that log the entry or exit of different vehicle types and call a helper macro to record the data in the spreadsheet, calculate delay times, and scroll to the latest entry. A delete macro is also defined to remove the latest entry from the log.

Uploaded by

dwaytikitan28
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
35 views3 pages

For Adding On Center View

The document defines macros to log vehicle entry and exit times in a spreadsheet. Keyboard shortcuts are assigned to call macros that log the entry or exit of different vehicle types and call a helper macro to record the data in the spreadsheet, calculate delay times, and scroll to the latest entry. A delete macro is also defined to remove the latest entry from the log.

Uploaded by

dwaytikitan28
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 3

Private Sub Workbook_Open()

Application.OnKey "^y", "LogMotorcycleEnter"


Application.OnKey "^+y", "LogMotorcycleExit"
Application.OnKey "^u", "LogTricycleEnter"
Application.OnKey "^+u", "LogTricycleExit"
Application.OnKey "^i", "LogBicycleEnter"
Application.OnKey "^+i", "LogBicycleExit"
Application.OnKey "^h", "LogCarEnter"
Application.OnKey "^+h", "LogCarExit"
Application.OnKey "^j", "LogJeepneysEnter"
Application.OnKey "^+j", "LogJeepneysExit"
Application.OnKey "^k", "LogBusEnter"
Application.OnKey "^+k", "LogBusExit"
Application.OnKey "^n", "LogHGVTEnter"
Application.OnKey "^+n", "LogHGVExit"
Application.OnKey "^m", "LogLGVTEnter"
Application.OnKey "^+m", "LogLGVExit"
Application.OnKey "^o", "DeleteLatestEntry"
End Sub

' Log Enter


Sub LogMotorcycleEnter()
LogTraffic "Motorcycle", "Enter"
End Sub

Sub LogTricycleEnter()
LogTraffic "Tricycle", "Enter"
End Sub

Sub LogBicycleEnter()
LogTraffic "Bicycle", "Enter"
End Sub

Sub LogCarEnter()
LogTraffic "Car", "Enter"
End Sub

Sub LogJeepneysEnter()
LogTraffic "Jeepneys", "Enter"
End Sub

Sub LogBusEnter()
LogTraffic "Bus", "Enter"
End Sub

Sub LogHGVTEnter()
LogTraffic "HGV Trucks", "Enter"
End Sub

Sub LogLGVTEnter()
LogTraffic "LGV Trucks", "Enter"
End Sub

' Log Exit


Sub LogMotorcycleExit()
LogTraffic "Motorcycle", "Exit"
End Sub

Sub LogTricycleExit()
LogTraffic "Tricycle", "Exit"
End Sub

Sub LogBicycleExit()
LogTraffic "Bicycle", "Exit"
End Sub

Sub LogCarExit()
LogTraffic "Car", "Exit"
End Sub

Sub LogJeepneysExit()
LogTraffic "Jeepneys", "Exit"
End Sub

Sub LogBusExit()
LogTraffic "Bus", "Exit"
End Sub

Sub LogHGVExit()
LogTraffic "HGV Trucks", "Exit"
End Sub

Sub LogLGVExit()
LogTraffic "LGV Trucks", "Exit"
End Sub

' Helper subroutine to log traffic


Sub LogTraffic(vehicleType As String, actionType As String)
Dim lastRow As Long
Dim i As Long
Dim enterTime As Date
Dim exitTime As Date
Dim delayTime As Date
Dim rng As Range

lastRow = Cells(Rows.Count, 1).End(xlUp).Row

If actionType = "Enter" Then


Cells(lastRow + 1, 1).Value = vehicleType
Cells(lastRow + 1, 2).Value = actionType
Cells(lastRow + 1, 3).Value = Format(Now, "HH:MM:SS")
Else
For i = 1 To lastRow
If Cells(i, 1).Value = vehicleType And Cells(i, 2).Value = "Enter" And
IsEmpty(Cells(i, 4)) Then
Cells(i, 4).Value = actionType
Cells(i, 5).Value = Format(Now, "HH:MM:SS")

' Calculate the delay time


enterTime = Cells(i, 3).Value
exitTime = Cells(i, 5).Value
delayTime = exitTime - enterTime

' Format the delay time as HH:MM:SS


Cells(i, 6).Value = Format(delayTime, "HH:MM:SS")

Exit For
End If
Next i
End If

' Scroll the sheet to keep the last entry visible


If actionType = "Enter" Then
Set rng = Cells(lastRow + 1, 1)
Else
Set rng = Cells(i, 4)
End If
Application.Goto rng.Offset(-15, 0), Scroll:=True
End Sub

' Delete Latest Entry in columns A, B, C


Sub DeleteLatestEntryABC()
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
If Not IsEmpty(Cells(lastRow, 1)) And IsEmpty(Cells(lastRow, 4)) Then
Range(Cells(lastRow, 1), Cells(lastRow, 3)).ClearContents
End If
End Sub

' Delete Latest Entry in columns D, E, F


Sub DeleteLatestEntryDEF()
Dim lastRow As Long
lastRow = Cells(Rows.Count, 4).End(xlUp).Row
If Not IsEmpty(Cells(lastRow, 4)) Then
Range(Cells(lastRow, 4), Cells(lastRow, 6)).ClearContents
End If
End Sub

You might also like