A vehicle database in Excel

Question

I'm looking for some help. I'm new to coding and have started creating this Vehicle database program in Excel for a friend to use.

He is wanting to be able to see all vehicles he owns, when registration is due as well as input any vehicle services that have been done.

• I have created a User form in Excel, one for adding a Vehicle and renewing Registration.
• This is working but I believe it isn't very efficient.
• Once I looked into it more and studied it more, I found that you shouldn't put information in the form as such; it is just a presenter and it should be read through modules and classes.
• I have tried doing this and I just get stuck and can't do it or get it to work. Is this required or is anything else in my coding to be fixed?

Please note that I didn't write the code for the calendar, hidebar or switch off. I can provide the code to them if required.

Vehicle table
Add Vehicle Form

Vehicle Form Code

On the Vehicle form they fill out their Vehicle Details:

• text boxes (Date of purchase, Regonumber, Rego Expiry, Purchase Price, Kms at Purchase, the VIN, Make, Model)
• choices (Year of Vehicle, Colour of Vehicle, Type of Vehicle (Car, Light Rigid, Motorbike etc.), Fuel Type (Unleaded Diesel etc.), Premium Class (to do with our state registration), Transmission Type (Automatic, Manual), Usage Type (whether they use the vehicle for Private or Business)

If they input Purchase price at a date after today it pops up an invalid date warning and makes the textbox red; if the Expiry Date is more than 4 months ago the same thing happens.

• The Purchase Date, (Rego, Expiry - if the Unregistered button isn't ticked), Year, Make, Model, Vehicle Type, Transmission type and Usage is required to be filled out to submit the vehicle to the table.
• When they click Add it adds it to the Table and unloads. If they click Cancel, a message box pops up to confirm, if yes then it just unloads.

Option Explicit
Private Sub UserForm_Initialize()
 Dim i As Long, a As Long
 Dim ws As Worksheet: Set ws = dropdown
 'hides the address bar at the top
 HideBar Me
 'things to make excel run quicker
 SwitchOff (True)
 With Me
 'Set Form Size
 .Height = 300
 .Width = 364
 'Hide Invalid date warning
 .Invalid_date.Visible = False
 .Invalid_Expiry.Visible = False
 'set Price Format
 .VCH_Price = "$"
 'count every year from this year to 1940 and add to Vechile year list.
 For i = VBA.Year(Now()) To a Step -1
 .VCH_year.AddItem i
 If i = 1940 Then Exit For
 Next
 'create comboboxes from tables on dropdown list page
 .VCH_Fuel.List = ws.Range("Fuel").Value2
 .VCH_Trans.List = ws.Range("Trans").Value2
 .VCH_Body.List = ws.Range("Colour").Value2
 .VCH_Type.List = ws.Range("type").Value2
 .VCH_Usage.List = ws.Range("Usage").Value2
 .VCH_Premium.List = ws.Range("Premium").Value2
 End With
End Sub
Private Sub OKButton_Click()
 Dim Vehicle_ID As String, result As Boolean
 Set TblVehicle = VehicleSheet.ListObjects("Tbl_Vehicle")
 
 'things to make excel conditions go back to what they were
 SwitchOff (False)
 
 'Loops through all the boxes and check the required are filled in
 result = FrmVehicleCheck(Me)
 If result = False Then MsgBox "missing information", vbInformation: Exit Sub
 
 'this creates the Vehicle id by adding make, model, body, year and rego together
 Vehicle_ID = VCH_Make & " " & VCH_Model & " " & VCH_Body & " " & VCH_year & " " & VCH_Rego
 'this loads the form onto the Vehicle table
 With TblVehicle.ListRows.Add
 .Range(1) = Vehicle_ID
 .Range(2) = VCH_Rego.value
 .Range(3) = IIf(VCH_Expiry = vbNullString, vbNullString, CDate(VCH_Expiry.value))
 'New rego date column goes here
 If Unregistered.value = True Then .Range(4) = "Yes"
 .Range(5) = VCH_year.value
 .Range(6) = VCH_Make.value
 .Range(7) = VCH_Model.value
 .Range(8) = VCH_Body.value
 .Range(9) = VCH_Vin.value
 .Range(10) = VCH_Trans.value
 .Range(11) = VCH_Fuel.value
 .Range(12) = VCH_Usage.value
 .Range(13) = VCH_Type.value
 .Range(14) = VCH_Premium.value
 .Range(15) = VCH_Kms.value
 .Range(16) = CDate(VCH_date.value)
 .Range(17) = VCH_Price.value
 End With
 Unload Me
End Sub
Private Sub CancelButton_click()
 'checks to make sure you want to cance
 Dim result As String
 result = MsgBox("Are you sure you want to cancel", vbYesNo)
 If result = vbNo Then Exit Sub
 SwitchOff (False)
 Unload Me
End Sub
Private Sub VCH_date_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 'when user double clicks on the date it will launch the calendar form then return with the value (picked)
 Launch
 With VCH_date
 .value = (picked)
 .value = VCH_date.value
 End With
 VCH_Rego.SetFocus
End Sub
Private Sub VCH_expiry_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 'when user double clicks on the date it will launch the calendar form then return with the value (picked)
 Launch
 With VCH_Expiry
 .value = (picked)
 .value = VCH_Expiry.value
 End With
 VCH_Price.SetFocus
End Sub
Private Sub VCH_make_keypress( _
 ByVal KeyAscii As MSForms.ReturnInteger)
 With VCH_Make
 If .value = vbNullString Then .BackColor = &H80000005
 End With
End Sub
Private Sub VCH_type_DropButtonClick()
 With VCH_Type
 If .value = vbNullString Then .BackColor = &H80000005
 End With
End Sub
Private Sub VCH_usage_DropButtonClick()
 With VCH_Usage
 If .value = vbNullString Then .BackColor = &H80000005
 End With
End Sub
Private Sub VCH_trans_DropButtonClick()
 With VCH_Trans
 If .value = vbNullString Then .BackColor = &H80000005
 End With
End Sub
Private Sub VCH_model_keypress( _
 ByVal KeyAscii As MSForms.ReturnInteger)
 With VCH_Model
 If .value = vbNullString Then .BackColor = &H80000005
 End With
End Sub
Private Sub VCH_year_DropButtonClick()
 With VCH_year
 If .value = vbNullString Then .BackColor = &H80000005
 End With
End Sub
Private Sub VCH_Rego_keypress( _
 ByVal KeyAscii As MSForms.ReturnInteger)
 With VCH_Rego
 If .value = vbNullString Then .BackColor = &H80000005
 End With
End Sub
Private Sub VCH_date_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 'if purchase date is later than today show error
 With VCH_date
 If IsDate(.value) Then
 If CDate(.value) > Date Then
 Invalid_date.Visible = True
 .BackColor = &HC0C0FF
 Else: Invalid_date.Visible = False
 .BackColor = &H80000005
 End If
 End If
 End With
End Sub
Private Sub VCH_expiry_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 'if expiry date is before than today show error
 With VCH_Expiry
 If IsDate(.value) Then
 If CDate(.value) < DateAdd("m", -4, Date) Then
 Invalid_Expiry.Visible = True
 .BackColor = &HC0C0FF
 Else: Invalid_Expiry.Visible = False
 .BackColor = &H80000005
 End If
 End If
 End With
End Sub
Private Sub VCH_price_change()
 VCH_Price = Format(VCH_Price, "$###,##")
End Sub
Private Sub VCH_price_KeyPress( _
 ByVal KeyAscii As MSForms.ReturnInteger)
 'makes it so user can only input numbers in text box and changes them to a $ figure
 Select Case KeyAscii
 Case Is < vbKey0, Is > vbKey9
 KeyAscii = 0
 Beep
 End Select
End Sub
Private Sub VCH_kms_KeyPress( _
 ByVal KeyAscii As MSForms.ReturnInteger)
 'makes it so user can only input numbers in text box
 Select Case KeyAscii
 Case Is < vbKey0, Is > vbKey9
 KeyAscii = 0
 Beep
 End Select
End Sub
Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
 'PURPOSE: Reset Userform buttons to Inactive Status
 CancelButtonInactive.Visible = True
 OKButtonInactive.Visible = True
End Sub
Sub OKButtonInactive_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
 'PURPOSE: Make OK Button appear Green when hovered on
 CancelButtonInactive.Visible = True
 OKButtonInactive.Visible = False
End Sub
Sub CancelButtonInactive_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
 'PURPOSE: Make Cancel Button appear Green when hovered on
 CancelButtonInactive.Visible = False
 OKButtonInactive.Visible = True
End Sub

Vehicle Module Code

Option Explicit
Sub Add_Vehicle_Click()
 
 If ActiveSheet.Name <> "Vehicle" Then
 Sheets("Vehicle").Activate
 Application.Wait (Now + 0.000006)
 Else: Sheets("Vehicle").Activate
 End If
 Add_Vehicle.Show
End Sub
'checked to make sure all the correct boxes in Add Vehicle are filled in
Public Function FrmVehicleCheck(FrmVehicle As UserForm) As String
 Dim result As String
 Dim ctrl As Control
 Set ctrl = Nothing
 
 With FrmVehicle
 For Each ctrl In .Controls
 If ctrl.Tag = "*" Then
 If Len(ctrl.Text) = 0 Then
 If Not ((ctrl.Name = "VCH_Rego" Or _
 ctrl.Name = "VCH_Expiry") And _
 .Unregistered.value = True) Then
 Debug.Print ctrl.Name
 ctrl.BackColor = &HC0C0FF
 result = ctrl.Name
 End If
 End If
 End If
 Next ctrl
 End With
FrmVehicleCheck = IIf(Len(result) = 0, True, False)
 'clearing references
 Set ctrl = Nothing
 Set FrmVehicle = Nothing
End Function

Renewal Table

Registration Renewal form

Registration Renewal Form filled

Registration Renewal

With the Registration Renewal form:

• The ComboBox has the Vehicle registrations from the Vehicle table where the vehicle hasn't been marked as disposed or unregistered and the Vehicle Expiry date is within 4 months of today.
• If they Select either Private or Business it clears all selections and populates the Registration Combobox with the above conditions but also filters and only populates the vehicles relevant to the selection (Private or Business).
• Once a vehicle has been selected then there are 4 Label boxes under the Registration Combobox that populate the information from selected. (I will provide a photo of this). It also populates the Registration Expiry date and makes the renewal period options appear (3 Months, 6 Months, 12 Months).
• Once one of the renewal periods are selected it populates the New Expiry date Label.
• You input the total. If you want to complete more renewals you select the More Renewals tick box.
• You then press Add; it inputs all the data in the Renewals Table and updates the Expiry date in the Vehicles table.
• If the More Renewals box was ticked it returns the form in a cleared state to update another Registration Expiry otherwise it unloads.
• If you press cancel a warning pops up and if you press okay it unloads.

Option Explicit
Private rownum As String, Optmonth As String
Private Sub UserForm_Initialize()
 Set FrmRenewal = Me
 Set TblVehicle = [Tbl_Vehicle].ListObject
 Dim Vehicle As New ClsVehicle
 'hide address bar
 HideBar Me
 'make excel run faster
 SwitchOff (True)
 'Run procedure to get Rego data that is has expired less than 4 months ago and due within the next 3 months
 
 Rego_Filtered_Data
 'hide the period selection buttons until a rego is selected
 UpdatePeriods ("Hide")
 'set form size and hide the Period buttons
 With Me
 '.Rego_ID.AddItem Vehicle.Regodue
 .Height = 235
 .Width = 274
 End With
End Sub
Private Sub Rego_Bus_Click()
'clear data from form
'filter the Rego ID to only show Business Vehicles
 clearform ("Bus")
 filterusage ("Business")
End Sub
Private Sub Rego_pri_Click()
'clear data from form
'filter the Rego ID to only show Private Vehicles
 clearform ("Pri")
 filterusage ("Private")
End Sub
Private Sub Rego_ID_Click()
 'auto populates Vechicle details and populates vehicle details and expiry dates
 'clear all previous data
 UpdatePeriods
 With Me
 'Attempt to find value in Table's first Column
 rownum = RegoRownum(Rego_ID.value)
 'get data from each column and input into the form
 .Rego_Num.Caption = TblVehicle.DataBodyRange(rownum, 2)
 .Rego_Make.Caption = TblVehicle.DataBodyRange(rownum, 6)
 .Rego_Model.Caption = TblVehicle.DataBodyRange(rownum, 7)
 .Rego_Colour.Caption = TblVehicle.DataBodyRange(rownum, 8)
 .Rego_Expiry.value = Format(TblVehicle.DataBodyRange(rownum, 3), "DD/MM/YYYY")
 'if the Rego expiry box isnt empty then calculate the Rego renewal periods and input them
 If Not .Rego_Expiry.value = vbNullString Then UpdatePeriods (Rego_Expiry.value)
 End With
End Sub
Private Sub OKButton_Click()
 Set TblRenewal = [Tbl_Renewal].ListObject
 ' if relevent sections arent filled out make them red and return back to form
 If FrmRenewalcheck = False Then MsgBox "missing information", vbInformation: Exit Sub
 'input data into the Renewal table
 With TblRenewal.ListRows.Add
 .Range(1) = Rego_ID.Text
 .Range(2) = Rego_Num.BoundValue
 .Range(3) = Rego_Make.BoundValue
 .Range(4) = Rego_Model.BoundValue
 .Range(5) = CDate(Rego_Expiry.BoundValue)
 .Range(6) = CDate(New_Date.BoundValue)
 .Range(7) = Optmonth
 .Range(8) = Total.value
 .Range(9) = Date
 End With
 'look in the Vehicle table for the Rego ID and input the new expiry date in the New Rego Date field
rownum = RegoRownum(Rego_ID.value)
TblVehicle.DataBodyRange(rownum, 3) = CDate(New_Date.BoundValue)
 'if the more renewals button is pressed restart form, if not clcose form
 If More = True Then
 SwitchOff (False)
 clearform ("Refresh")
 Rego_Filtered_Data
 SwitchOff (True)
 Exit Sub
 Else: Unload Me
 End If
 
 SwitchOff (False)
 'removing references
 Set TblVehicle = Nothing
End Sub
Private Sub CancelButton_click()
 'checking you want to cancel
 Dim result As String
 result = MsgBox("Are you sure you want to cancel", vbYesNo)
 If result = vbNo Then Exit Sub
 SwitchOff (False)
 Unload Me
 Set TblVehicle = Nothing
End Sub
Private Sub Option3M_Click()
 'clears the other two Renewal button values and inputs the period renewal date in the new expiry period
 Optmonth = Newperiod("Option3M")
End Sub
Private Sub Option6M_Click()
 'clears the other two Renewal button values and inputs the period renewal date in the new expiry period
 Optmonth = Newperiod("Option6M")
End Sub
Private Sub Option12M_Click()
 'clears the other two Renewal button values and inputs the period renewal date in the new expiry period
 Optmonth = Newperiod("Option12M")
End Sub
Private Sub Total_change()
 Total = Format(Total, "$###,##")
End Sub
Private Sub Total_KeyPress( _
 ByVal KeyAscii As MSForms.ReturnInteger)
 'makes it so user can only input numbers in text box and changes them to a $ figure
 Select Case KeyAscii
 Case Is < vbKey0, Is > vbKey9
 KeyAscii = 0
 Beep
 End Select
End Sub
Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
 'PURPOSE: Reset Userform buttons to Inactive Status
 CancelButtonInactive.Visible = True
 OKButtonInactive.Visible = True
End Sub
Sub OKButtonInactive_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
 'PURPOSE: Make OK Button appear Green when hovered on
 CancelButtonInactive.Visible = True
 OKButtonInactive.Visible = False
End Sub
Sub CancelButtonInactive_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
 'PURPOSE: Make Cancel Button appear Green when hovered on
 CancelButtonInactive.Visible = False
 OKButtonInactive.Visible = True
End Sub

Renewal module

Option Explicit
Sub Rego_Renewal_Click()
 Rego_Renewal.Show
End Sub
Global TblVehicle As ListObject, TblRenewal As ListObject, FrmRenewal As MSForms.UserForm
Dim ctrl As Control, rowNumbers() As Long ' Array to store row numbers
Sub Rego_Filtered_Data()
 Dim RngRego As Range: Set RngRego = TblVehicle.ListColumns("Vehicle ID").DataBodyRange
 Dim RngExpiry As Range: Set RngExpiry = TblVehicle.ListColumns("Rego expiry").DataBodyRange
 Dim RngDisposed As Range: Set RngDisposed = TblVehicle.ListColumns("Disposal Date").DataBodyRange
 Dim x As Long, rw As Long
 Dim StrRego_filtered As String
 
 Dim beforedate As Date, afterdate As Date
 beforedate = DateAdd("m", 4, Date)
 afterdate = DateAdd("m", -4, Date)
 
 x = 1
 'look for registrations that expired 4 months ago to due in the next 4 months and return in a combobox
 'if vehicle is marked as disposed then skip and dont show in renewal
 If Not IsEmpty(RngDisposed.Cells(rw, 1)) Then
 For rw = RngRego.Rows.Count To 1 Step -1
 Select Case RngExpiry.Cells(rw, 1)
 Case afterdate To beforedate
 StrRego_filtered = RngRego.Cells(rw, 1).value
 Debug.Print StrRego_filtered
 Debug.Print RngExpiry.Cells(rw, 1).value
 With FrmRenewal.Rego_ID
 .AddItem StrRego_filtered
 .ColumnCount = 1
 End With
 ReDim Preserve rowNumbers(1 To x)
 rowNumbers(x) = rw
 x = x + 1
 End Select
 Debug.Print rw
 Next rw
 End If
 Debug.Print StrRego_filtered
 Application.ScreenUpdating = False
End Sub
Function FrmRenewalcheck() As String
 Dim result As String
 Dim Counta As Byte
 Set ctrl = Nothing
 Counta = 0
 For Each ctrl In FrmRenewal.Controls
 With ctrl
 Select Case TypeName(ctrl)
 Case "ComboBox"
 If .ListIndex = -1 Then
 .BackColor = &HC0C0FF
 Debug.Print .Name
 result = .Name
 End If
 Case "Label"
 If .Name = "New_Date" And .Caption = vbNullString Then
 .BackColor = &HC0C0FF
 Debug.Print .Name
 result = .Name
 End If
 Case "OptionButton"
 If .GroupName = "Period" And .value = False Then
 If Left(.Name, 6) = "Option" Then Counta = Counta + 1
 If Counta = 3 Then
 With FrmRenewal
 .Option3M.BackColor = &HC0C0FF
 .Option6M.BackColor = &HC0C0FF
 .Option12M.BackColor = &HC0C0FF
 result = ctrl.Name
 Debug.Print ctrl.Name
 End With
 End If
 End If
 Case "TextBox"
 If Len(.Text) = 0 Then
 .BackColor = &HC0C0FF
 Debug.Print .Name
 result = .Name
 End If
 End Select
 End With
 Next ctrl
 FrmRenewalcheck = IIf(Len(result) = 0, True, False)
 'clearing references
 Set ctrl = Nothing
End Function
Function Newperiod(OpName As String) As String
 Dim SelPeriod As String
 'initialise
 Set ctrl = Nothing
 'loop controls looking for option button that is
 'both true and part of input GroupName
 For Each ctrl In FrmRenewal.Controls
 Select Case TypeName(ctrl)
 Case Is = "OptionButton"
 If ctrl.GroupName = "Period" Then
 If ctrl.Name = OpName Then
 ctrl.value = True
 SelPeriod = Replace(OpName, "Option", "Rego_")
 FrmRenewal.New_Date = FrmRenewal.Controls.Item(SelPeriod)
 Newperiod = SelPeriod
 FrmRenewal.Total = vbNullString
 Else: ctrl.value = False
 End If
 End If
 End Select
 Next ctrl
 'clear references
 Set ctrl = Nothing
End Function
Public Sub clearform(proc As String)
 Set ctrl = Nothing
 For Each ctrl In FrmRenewal.Controls
 With ctrl
 Select Case .Tag
 Case Is = "clear"
 Select Case TypeName(ctrl)
 Case Is = "TextBox"
 .value = vbNullString
 .BackColor = &H80000005
 Case Is = "ComboBox"
 .Clear
 .BackColor = &H80000005
 Case Is = "Label"
 .Caption = vbNullString
 .BackColor = &H80000005
 Case Is = "OptionButton"
 .Visible = False
 .value = False
 .BackColor = &H80000005
 Case Is = "CheckBox"
 .value = False
 .BackColor = &H80000005
 End Select
 Case Is = vbNullString
 If TypeName(ctrl) = "OptionButton" And proc = "Refresh" Then .value = False: .BackColor = &H80000005
 End Select
 End With
 Next ctrl
 Set ctrl = Nothing
End Sub
Function filterusage(Opttype As String)
 Dim filteredRows() As Range ' Array to store filtered rows
 Dim finalRowCount As Long
 Dim StrRego_filteredUsage As String
 Dim i As Long ' Variable to iterate through the row numbers array
 
 ' Loop through the row numbers array
 For i = LBound(rowNumbers) To UBound(rowNumbers)
 ' Access the corresponding row in the table using the row number
 Dim currentRow As Range
 Set currentRow = TblVehicle.DataBodyRange.Rows(rowNumbers(i))
 
 ' Check if another column meets the additional criteria
 Dim rngUsage As Range
 Set rngUsage = currentRow.Cells(, 12) ' Replace columnNumber with the desired column index
 
 ' Apply additional filtering based on the criteria
 If rngUsage.value = Opttype Then
 ' Add the filtered row to the array
 Dim RngRego As Range
 Set RngRego = TblVehicle.ListColumns(1).DataBodyRange
 StrRego_filteredUsage = RngRego.Cells(rowNumbers(i), 1).value
 Debug.Print StrRego_filteredUsage
 With FrmRenewal.Rego_ID
 .AddItem StrRego_filteredUsage
 .ColumnCount = 1
 End With
 ReDim Preserve filteredRows(1 To finalRowCount + 1)
 End If
 Next i
End Function
Function RegoRownum(VehicleID As String) As Long
 Dim FoundCell As Range
 On Error Resume Next
 Set FoundCell = TblVehicle.DataBodyRange.Columns(1).Find(VehicleID, LookAt:=xlWhole)
 On Error GoTo 0
 If Not FoundCell Is Nothing Then RegoRownum = _
 TblVehicle.ListRows(FoundCell.Row - TblVehicle.HeaderRowRange.Row).index
End Function
Function UpdatePeriods(Optional NewVal As String) As Long
 With FrmRenewal
 Select Case NewVal
 Case Is = vbNullString
 .Option3M.value = False
 .Option6M.value = False
 .Option12M.value = False
 .Rego_3M = vbNullString
 .Rego_6M = vbNullString
 .Rego_12M = vbNullString
 .New_Date = vbNullString
 Case Is = "Hide"
 .Option3M.Visible = False
 .Option6M.Visible = False
 .Option12M.Visible = False
 .Rego_3M = vbNullString
 .Rego_6M = vbNullString
 .Rego_12M = vbNullString
 .New_Date = vbNullString
 Case Else
 .Rego_3M.Caption = DateAdd("m", 3, NewVal)
 .Option3M.Visible = True
 .Rego_6M.Caption = DateAdd("m", 6, NewVal)
 .Option6M.Visible = True
 .Rego_12M.Caption = DateAdd("m", 12, NewVal)
 .Option12M.Visible = True
 End Select
 End With
End Function

• Kendall Briggs: @Greedo I have no idea how to add an example of the workbook. I have updated the post to provide further information about the forms
• Kendall Briggs: @Greedo dropbox.com/scl/fi/ie80ndy2l900m0r6c2n8j/… Let me know if this works
• Parfait: Consider using Excel's PC sibling, MS Access, which is actually a database and ships with user interface forms (even report generator) to add/edit/delete records without any code to start!