Private Sub cmdexit_Click()
Unload Me
End Sub
Function ControlsArr()
ControlsArr = Array(txtreg, combo, txtmodel, txtpdate, txtpprice, txtsdate, txtsprice)
End Function
Private Sub cmdnew_Click()
Dim Control As Variant
'clear controls
For Each Control In ControlsArr
Control.Text = ""
Next
Me.ComboBox1.Value = ""
With Me.txtreg
.SetFocus
.Locked = False
End With
'change status
With Me.cmdsubmit
.Caption = "SUBMIT"
.BackColor = vbBlack
End With
End Sub
Private Sub cmdsubmit_Click()
Dim erow As Long, c As Long
Dim m As Variant, Control As Variant
Dim RegNo As String
Dim NewRecord As Boolean
RegNo = Me.txtreg.Text
If Trim(Me.txtreg.Value) = "" Then
Me.txtreg.SetFocus
MsgBox "Please enter valid reg", 48, "Enter Reg No"
Exit Sub
End If
m = Application.Match(RegNo, Sheet1.Columns(1), 0)
NewRecord = CBool(IsError(m))
If Not NewRecord Then If MsgBox(RegNo & Chr(10) & "Update Record?", 36, "Update Record") = vbNo Then Exit Sub
With Sheet1
'get record row
erow = IIf(NewRecord, .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row, CLng(m))
End With
'add record to sheet
'note IsDate & IsNumeric functions do not always work as intended
For Each Control In ControlsArr
c = c + 1
With Control
If IsDate(.Text) Then
Sheet1.Cells(erow, c).Value = DateValue(.Text)
ElseIf IsNumeric(.Text) Then
Sheet1.Cells(erow, c).Value = Val(.Text)
Else
Sheet1.Cells(erow, c).Value = .Text
End If
End With
Next
'inform user
msg = IIf(NewRecord, "New Record Entered", "Record Updated")
MsgBox RegNo & Chr(10) & msg, 64, msg
'refresh combobox
If NewRecord Then ComboBox1_Refresh
End Sub
Private Sub ComboBox1_Refresh()
Dim LastRow As Long
With Me.ComboBox1
.Clear
LastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
.List = Sheet1.Cells(3, 1).Resize(LastRow - 2).Value2
End With
End Sub
Private Sub ComboBox1_Change()
Dim RegNo As String
Dim m As Variant
Dim c As Long
RegNo = ComboBox1.Text
If Len(RegNo) = 0 Then Exit Sub
m = Application.Match(RegNo, Sheet1.Columns(1), 0)
If Not IsError(m) Then
For Each Control In ControlsArr
c = c + 1
Control.Text = Sheet1.Cells(CLng(m), c).Value
Next
'change status
With Me.cmdsubmit
.Caption = "UPDATE"
.BackColor = vbRed
End With
'prevent editing
Me.txtreg.Locked = True
End If
End Sub
Private Sub txtpdate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(txtpdate.Text) > 0 And Not IsDate(txtpdate.Text) Then
MsgBox "Date required", 48, "Date Required"
Cancel = True
End If
End Sub
Private Sub txtreg_AfterUpdate()
Dim a As Long
Dim RegNo As String
RegNo = Me.txtreg.Text
If Len(RegNo) = 0 Then Exit Sub
a = Application.WorksheetFunction.CountIf(Sheet1.Range("A:A"), RegNo)
If a >= 1 Then
MsgBox RegNo & Chr(10) & "Registration already exists", 16, "Record Exists"
Me.txtreg = ""
End If
End Sub
Private Sub txtsdate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(txtsdate.Text) > 0 And Not IsDate(txtsdate.Text) Then
MsgBox "Date required", 48, "Date Required"
Cancel = True
End If
End Sub
Private Sub UserForm_Initialize()
ComboBox1_Refresh
End Sub
