Private Sub cmdOverdue_Click()
'error statement
On Error Goto errHandler:
'clear the listbox
lstLookup.RowSource = ""
'clear controls
Me.txtLookup.Value = ""
Me.cboStart.Value = ""
'add department and date range to criteria
With Sheet2
.Range("P7").Value = ""
.Range("Q7").Value = ""
.Range("R7").Value = Me.cboDepartment.Value
.Range("O7").Value = "=""<=""&TODAY()"
End With
'run the filter
AdvFilter
'check for value and adjust rowsource to avoid an error
If Sheet2.Range("T7").Value = "" Then
lstLookup.RowSource = ""
Else
lstLookup.RowSource = "Filter_Staff"
End If
'error block
On Error Goto 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub cmdAdd_Click()
'declare the valiable
Dim nextrow As Range
'error handler
On Error Goto errHandler:
Application.ScreenUpdating = False
'force user to click the option button
If Me.Reg4.Enabled = False Then
MsgBox "You need to click the Add Option Button"
Exit Sub
End If
'set the next row in the database
Set nextrow = Sheet2.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
'check for values in all controls
If Me.Reg8.Value = "New" Or Me.Reg8.Value = "Once" Then
For X = 1 To 8
If Me.Controls("Reg" & X).Value = "" Then
MsgBox "You need to add the skill and first and last names"
Exit Sub
End If
Next
Else
For X = 1 To 10
If Me.Controls("Reg" & X).Value = "" Then
MsgBox "You need to add the skill and first and last names"
Exit Sub
End If
Next
End If
'check for duplicate staff
If WorksheetFunction.CountIf(Sheet2.Range("F:F"), Me.Reg4.Value) > 0 Then
MsgBox "This staff member already exists"
Exit Sub
End If
'add value to the next row in the database
nextrow = Reg1.Value
nextrow.Offset(0, 1) = Reg2.Value
nextrow.Offset(0, 2) = Reg3.Value
nextrow.Offset(0, 3) = Reg4.Value
nextrow.Offset(0, 4) = Reg5.Value
nextrow.Offset(0, 5) = Reg6.Value
'format the date controlls
With nextrow
.Offset(0, 6).Value = Format(Reg7.Value, "mm/dd/yy")
End With
nextrow.Offset(0, 7) = Reg8.Value
With nextrow
.Offset(0, 8).Value = Format(Reg9.Value, "mm/dd/yy")
End With
nextrow.Offset(0, 9) = Reg10.Value
'sort the database
Sortit
'set the criteria for the filter to show the department
With Sheet2
.Range("P7").Value = ""
.Range("Q7").Value = ""
.Range("R7").Value = Me.Reg5.Value
.Range("O7").Value = ""
End With
'run the filter
AdvFilter
'add the rowsource to the listbox
lstLookup.RowSource = "Filter_Staff"
'clear the controls
For X = 1 To cNum
Me.Controls("Reg" & X).Value = ""
Next
Me.optAdd = False
'error block
On Error Goto 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub cmdTraining_Click()
'declare the variables
Dim cNum As Integer
Dim nextrow As Range
Dim MyCell As Range
Dim rng As Long
'error handling
On Error Goto errHandler:
'check for values
If Reg1.Value = "" Or Reg4.Value = "" Then
MsgBox "There is not data to edit"
Exit Sub
End If
'check for duplicates
rng = Sheet2.Cells(Rows.Count, "F").End(xlUp).Row
For Each MyCell In Sheet2.Range("F7:F" & rng)
If MyCell = Me.Reg4.Value And MyCell.Offset(0, 2).Value = Me.Reg6.Value Then
MsgBox "This training already exists for this staff member"
Exit Sub
End If
Next MyCell
'check that the date is a date
If Not IsDate(Me.Reg7) Then
MsgBox "Completed date must be a date format"
Exit Sub
End If
'find the next row to add data to
Set nextrow = Sheet2.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
'check for values in the controls
If Me.Reg6.Value = "" Or Me.Reg7.Value = "" Or Me.Reg8.Value = "" Then
MsgBox "You need to add all data"
Exit Sub
End If
'clear the listbox
lstLookup.RowSource = ""
'add the values to the database
nextrow = Reg1.Value
nextrow.Offset(0, 1) = Reg2.Value
nextrow.Offset(0, 2) = Reg3.Value
nextrow.Offset(0, 3) = Reg4.Value
nextrow.Offset(0, 4) = Reg5.Value
nextrow.Offset(0, 5) = Reg6.Value
'format the date values on the worksheet
With nextrow
.Offset(0, 6).Value = Format(Reg7.Value, "mm/dd/yy")
End With
nextrow.Offset(0, 7) = Reg8.Value
With nextrow
.Offset(0, 8).Value = Format(Reg9.Value, "mm/dd/yy")
End With
nextrow.Offset(0, 9) = Reg10.Value
'sort the database
Sortit
'run the filter
AdvFilter
'refresh the rowsource in the listbox
lstLookup.RowSource = ""
lstLookup.RowSource = "Filter_Staff"
'error block
On Error Goto 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub cmdEdit_Click()
'declare the variables
Dim findvalue As Range, c As Range
Dim cNum As Integer
'error handling
On Error Goto errHandler:
'check for values
If Reg1.Value = "" Or Reg4.Value = "" Then
MsgBox "There is not data to edit"
Exit Sub
End If
'check to see if the date is entered
If Not IsDate(Me.Reg7) Then
MsgBox "Completed date must be a date format"
Exit Sub
End If
'clear the listbox
lstLookup.RowSource = ""
'find the row to edit
Set findvalue = Sheet2.Range("L:L").Find(What:=Reg10, LookIn:=xlValues).Offset(0, -9)
'update the values
findvalue = Reg1.Value
findvalue.Offset(0, 1) = Reg2.Value
findvalue.Offset(0, 2) = Reg3.Value
findvalue.Offset(0, 3) = Reg4.Value
findvalue.Offset(0, 4) = Reg5.Value
findvalue.Offset(0, 5) = Reg6.Value
'format date values
With findvalue
.Offset(0, 6).Value = Format(Reg7.Value, "mm/dd/yy")
End With
findvalue.Offset(0, 7) = Reg8.Value
With findvalue
.Offset(0, 8).Value = Format(Reg9.Value, "mm/dd/yy")
End With
findvalue.Offset(0, 9) = Reg10.Value
'run the filter
AdvFilter
'add the new values to the listbox
lstLookup.RowSource = "Filter_Staff"
'error block
On Error Goto 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & _
"The error number is: " & Err.Number & vbCrLf & _
Err.Description & vbCrLf & "Please notify the administrator"
End Sub
Private Sub optAdd_Click()
'what to do when the add option button is clicked
'clear the controls
cNum = 10
For X = 1 To cNum
Me.Controls("Reg" & X).Value = ""
Next
'enable and color first 9 controls
cNum = 9
For X = 1 To cNum
Me.Controls("Reg" & X).BackColor = RGB(255, 255, 255)
Me.Controls("Reg" & X).Enabled = True
Next
'add new ID
With Me
.Reg10.Value = Sheet2.Range("J2").Value + 1
'disable last control
.Reg10.Enabled = False
.Reg10.BackColor = RGB(220, 220, 220)
'disable the edit button
.cmdEdit.Enabled = False
.cmdEdit.BackColor = RGB(220, 220, 220)
.cmdTraining.Enabled = False
.cmdTraining.BackColor = RGB(220, 220, 220)
'enable the add button
.cmdAdd.Enabled = True
.cmdAdd.BackColor = RGB(0, 51, 0)
End With
End Sub
Private Sub optEdit_Click()
'what ot do when the edit option is selected
'disable first 6 controls and change color
For X = 1 To 6
Me.Controls("Reg" & X).BackColor = RGB(220, 220, 220)
Me.Controls("Reg" & X).Enabled = False
Next
'enaable and diable controls
With Me
.Reg7.Enabled = True
.Reg7.BackColor = RGB(255, 255, 255)
.Reg8.Enabled = True
.Reg8.BackColor = RGB(255, 255, 255)
.Reg9.Enabled = True
.Reg9.BackColor = RGB(255, 255, 255)
.Reg10.Enabled = False
.Reg10.BackColor = RGB(220, 220, 220)
'enable the edit button
.cmdEdit.Enabled = True
.cmdEdit.BackColor = RGB(0, 51, 0)
'disable the add button and new training button
.cmdAdd.Enabled = False
.cmdAdd.BackColor = RGB(220, 220, 220)
.cmdTraining.Enabled = False
.cmdTraining.BackColor = RGB(220, 220, 220)
End With
End Sub
Private Sub optTraining_Click()
'check for values
If Me.Reg1.Value = "" Then
MsgBox "A staff member needs to be selected"
Me.optTraining = False
Exit Sub
End If
'add the ID value
Me.Reg10.Value = Sheet2.Range("J2").Value + 1
'enable and disable controls
Me.Reg10.Enabled = False
Me.Reg10.BackColor = RGB(220, 220, 220)
For X = 1 To 5
Me.Controls("Reg" & X).BackColor = RGB(220, 220, 220)
Me.Controls("Reg" & X).Enabled = False
Next
For X = 6 To 9
Me.Controls("Reg" & X).BackColor = RGB(255, 255, 255)
Me.Controls("Reg" & X).Enabled = True
Me.Controls("Reg" & X).Value = ""
Next
'disable and enable command buttons
Me.cmdTraining.Enabled = True
Me.cmdTraining.BackColor = RGB(0, 51, 0)
Me.cmdEdit.Enabled = False
Me.cmdEdit.BackColor = RGB(220, 220, 220)
Me.cmdAdd.Enabled = False
Me.cmdAdd.BackColor = RGB(220, 220, 220)
End Sub
Sub Setit()
'disable,clear values and change the back color of all controls
cNum = 10
For X = 1 To cNum
Me.Controls("Reg" & X).BackColor = RGB(220, 220, 220)
Me.Controls("Reg" & X).Enabled = False
Me.Controls("Reg" & X).Value = ""
Next
'clear the criteria range
With Sheet2
.Range("P7").Value = ""
.Range("Q7").Value = ""
.Range("R7").Value = ""
.Range("O7").Value = ""
End With
'clear the listbox
lstLookup.RowSource = ""
'clear the controls
With Me
.txtLookup.Value = ""
.cboDepartment.Value = ""
.cboStart.Value = ""
'disable buttons
.cmdTraining.Enabled = False
.cmdEdit.Enabled = False
.cmdAdd.Enabled = False
End With
End Sub
Private Sub Reg10_Change()
End Sub
Private Sub Reg6_AfterUpdate()
Dim MyCell As Range
Dim rng As Long
'check for duplicates
rng = Sheet2.Cells(Rows.Count, "F").End(xlUp).Row
For Each MyCell In Sheet2.Range("F7:F" & rng)
If MyCell = Me.Reg4.Value And MyCell.Offset(0, 2).Value = Me.Reg6.Value Then
MsgBox "This training already exists for this staff member"
Me.Reg6.Value = ""
Exit Sub
End If
Next MyCell
End Sub
Private Sub Reg7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'check for date value
Me.Reg7 = Format(Me.Reg7, "mm/dd/yy")
If Not IsDate(Me.Reg7) Then
MsgBox "Completed date must be a date format"
Me.Reg7.Value = ""
Exit Sub
End If
End Sub
Private Sub Reg8_Change()
'add values to criteria
Me.Reg9.Value = Format(Me.Reg9.Value, "mm/dd/yy")
With Sheet3
.Range("O7").Value = Format(Me.Reg7.Value, "mm/dd/YY")
.Range("P7").Value = Me.Reg8.Value
End With
Me.Reg9.Value = Format(Sheet3.Range("Q7").Value, "mm/dd/yy")
End Sub
Private Sub Reg9_Change()
Me.Reg9 = Format(Me.Reg9, "mm/dd/yy")
End Sub
Private Sub UserForm_Initialize()
'format the control
Me.Reg7 = Format(Me.Reg7, "mm/dd/yy")
Me.Reg9 = Format(Me.Reg9, "mm/dd/yy")
cNum = 10
For X = 1 To cNum
Me.Controls("Reg" & X).BackColor = RGB(220, 220, 220)
Me.Controls("Reg" & X).Enabled = False
Me.Controls("Reg" & X).Value = ""
Next
With Me
'clear the listbox
Me.lstLookup.RowSource = ""
'disable ID
Me.Reg4.Enabled = False
'change the back color
Me.Reg4.BackColor = RGB(220, 220, 220)
'disable controls
Me.cmdEdit.Enabled = False
Me.cmdEdit.BackColor = RGB(220, 220, 220)
Me.cmdAdd.Enabled = False
Me.cmdAdd.BackColor = RGB(220, 220, 220)
Me.cmdTraining.Enabled = False
Me.cmdTraining.BackColor = RGB(220, 220, 220)
End With
AdvFilter
End Sub
Bookmarks