Option Explicit'Private variables
Dim cNum As Integer
Dim X As Integer
Private Sub cmdLookup_Click()
'call lookup macro
Lookup
End Sub
Private Sub Reg17_Change()
If IsDate(Me.Reg17) Then Me.Reg20 = _
"" & Format(DateDiff("d", Now(), Me.Reg17), "#,###")
End Sub
Sub Lookup()
'declare the variables
Dim Due As Variant
'error statement
On Error GoTo errHandler:
'clear the listbox
lstLookup.RowSource = ""
'set the variable
Due = Me.cboStart.Value
'if "New" or "Once" is selected run a different filter
If Me.cboStart.Value = "Once" Or Me.cboStart.Value = "New" Then
Sheet2.Range("X7").Value = Me.cboStart.Value
AdvFilter_Once
'if the results are nil then clear the rowsource to avoid an error
If Sheet2.Range("AD7").Value = "" Then
lstLookup.RowSource = ""
Else
'add range to rowsource if range has values
lstLookup.RowSource = "Filter_Staff"
End If
Exit Sub
End If
'if no date selected for criteria
With Sheet2
If Me.cboStart = "" Then
.Range("Y7").Value = ""
.Range("Z7").Value = ""
.Range("AA7").Value = Me.txtLookup
.Range("AB7").Value = Me.cboDepartment
'if date is selected
Else
.Range("Z7").Value = "=""<""&TODAY()" & "+" & Due
.Range("Y7").Value = "="">""&TODAY()"
.Range("AA7").Value = Me.txtLookup
.Range("AB7").Value = Me.cboDepartment
End If
End With
'run the filter
AdvFilter
'if the results are nil then clear the rowsource to avoid an error
If Sheet2.Range("AD7").Value = "" Then
lstLookup.RowSource = ""
Else
'add range to rowsource if range has values
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 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("Z7").Value = ""
.Range("AA7").Value = ""
.Range("AB7").Value = Me.cboDepartment.Value
.Range("Y7").Value = "=""<=""&TODAY()"
End With
'run the filter
AdvFilter
'check for value and adjust rowsource to avoid an error
If Sheet2.Range("AD7").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 lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
Dim ID As String
Dim I As Integer
Dim findvalue
'error block
On Error GoTo errHandler:
'get the select value from the listbox
For I = 0 To lstLookup.ListCount - 1
If lstLookup.Selected(I) = True Then
'set the listbox column
ID = lstLookup.List(I, 19)
End If
Next I
'find the value in the range
Set findvalue = Sheet2.Range("V:V").Find(What:=ID, LookIn:=xlValues).Offset(0, -19)
'add the values to the userform controls
Me.Reg1.Value = findvalue
Me.Reg2.Value = findvalue.Offset(0, 1)
Me.Reg3.Value = findvalue.Offset(0, 2)
Me.Reg4.Value = findvalue.Offset(0, 3)
Me.Reg5.Value = findvalue.Offset(0, 4)
Me.Reg6.Value = findvalue.Offset(0, 5)
Me.Reg7.Value = Format(findvalue.Offset(0, 6), "dd/mm/yy")
Me.Reg8.Value = findvalue.Offset(0, 7)
Me.Reg9.Value = findvalue.Offset(0, 8)
Me.Reg10.Value = findvalue.Offset(0, 9)
Me.Reg11.Value = findvalue.Offset(0, 10)
Me.Reg12.Value = findvalue.Offset(0, 11)
Me.Reg13.Value = findvalue.Offset(0, 12)
Me.Reg14.Value = findvalue.Offset(0, 13)
Me.Reg15.Value = findvalue.Offset(0, 14)
Me.Reg16.Value = findvalue.Offset(0, 15)
Me.Reg17.Value = Format(findvalue.Offset(0, 16), "dd/mm/yy")
Me.Reg18.Value = findvalue.Offset(0, 17)
Me.Reg19.Value = findvalue.Offset(0, 18)
Me.Reg99.Value = findvalue.Offset(0, 19)
'cNum = 20
'For X = 1 To cNum
'Me.Controls("Reg" & X).Value = findvalue
'Set findvalue = findvalue.Offset(0, 1)
'Next
'disable the controls to make the user select an option
'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
Me.Reg99.Value = Sheet2.Range("J2").Value + 1
If Me.Reg3.Enabled = False Then
MsgBox "You need to click the Add Option Button"
Exit Sub
End If
'THIS BELOW MAY CAUSE AN ISSUE
'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 9
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 9
If Me.Controls("Reg" & X).Value = "" Then
MsgBox "Please ensure boxes 1 to 9 have been completed"
Exit Sub
End If
Next
End If
'check for duplicate staff
If WorksheetFunction.CountIf(Sheet2.Range("E:E"), Me.Reg3.Value) > 0 Then
MsgBox "This staff member already exists"
Exit Sub
End If
'HERE
'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
nextrow.Offset(0, 7) = Reg8.Value
nextrow.Offset(0, 8) = Reg9.Value
nextrow.Offset(0, 9) = Reg10.Value
nextrow.Offset(0, 10) = Reg11.Value
nextrow.Offset(0, 11) = Reg12.Value
nextrow.Offset(0, 12) = Reg13.Value
nextrow.Offset(0, 13) = Reg14.Value
nextrow.Offset(0, 14) = Reg15.Value
nextrow.Offset(0, 15) = Reg16.Value
nextrow.Offset(0, 17) = Reg18.Value
nextrow.Offset(0, 18) = Reg19.Value
nextrow.Offset(0, 19) = Reg99.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, 8) = Reg8.Value
With nextrow
.Offset(0, 16).Value = Format(Reg17.Value, "mm/dd/yy")
End With
nextrow.Offset(0, 19) = Reg99.Value
'HERE
'sort the database
Sortit
'set the criteria for the filter to show the department
With Sheet2
.Range("Z7").Value = ""
.Range("AA7").Value = ""
.Range("AB7").Value = Me.Reg5.Value
.Range("Y7").Value = ""
End With
'run the filter
AdvFilter
'add the rowsource to the listbox
lstLookup.RowSource = "Filter_Staff"
'clear the controls
For X = 1 To 20
Me.Controls("Reg" & X).Value = ""
Next
'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 duplicates
'rng = Sheet2.Cells(Rows.Count, "E").End(xlUp).Row
'For Each MyCell In Sheet2.Range("E7:E" & rng)
'If MyCell = Me.Reg3.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 for values
Me.Reg99.Value = Sheet2.Range("J2").Value + 1
If Reg1.Value = "" Or Reg3.Value = "" Then
MsgBox "There is not data to add"
Exit Sub
End If
'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 USE THIS TO CHECK DATA HAS BEEN ADDED IN FIELDS
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
nextrow.Offset(0, 7) = Reg8.Value
nextrow.Offset(0, 8) = Reg9.Value
nextrow.Offset(0, 9) = Reg10.Value
nextrow.Offset(0, 10) = Reg11.Value
nextrow.Offset(0, 11) = Reg12.Value
nextrow.Offset(0, 12) = Reg13.Value
nextrow.Offset(0, 13) = Reg14.Value
nextrow.Offset(0, 14) = Reg15.Value
nextrow.Offset(0, 15) = Reg16.Value
nextrow.Offset(0, 17) = Reg18.Value
nextrow.Offset(0, 18) = Reg19.Value
nextrow.Offset(0, 19) = Reg99.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, 8) = Reg8.Value
With nextrow
.Offset(0, 16).Value = Format(Reg17.Value, "mm/dd/yy")
End With
nextrow.Offset(0, 19) = Reg99.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
Dim cNum As Integer
'error handling
On Error GoTo errHandler:
'check for values
If Reg1.Value = "" Or Reg3.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("V:V").Find(What:=Reg99, LookIn:=xlValues).Offset(0, -19)
'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
findvalue.Offset(0, 7) = Reg8.Value
findvalue.Offset(0, 8) = Reg9.Value
findvalue.Offset(0, 9) = Reg10.Value
findvalue.Offset(0, 10) = Reg11.Value
findvalue.Offset(0, 11) = Reg12.Value
findvalue.Offset(0, 12) = Reg13.Value
findvalue.Offset(0, 13) = Reg14.Value
findvalue.Offset(0, 14) = Reg15.Value
findvalue.Offset(0, 15) = Reg16.Value
findvalue.Offset(0, 17) = Reg18.Value
findvalue.Offset(0, 18) = Reg19.Value
findvalue.Offset(0, 19) = Reg99.Value
'format date values
With findvalue
.Offset(0, 6).Value = Format(Reg7.Value, "mm/dd/yy")
End With
'findvalue.Offset(0, 8) = Reg8.Value
With findvalue
.Offset(0, 16).Value = Format(Reg17.Value, "mm/dd/yy")
End With
findvalue.Offset(0, 19) = Reg99.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 cmdDelete_Click()
'declare the variables
Dim findvalue As Range
Dim cDelete As VbMsgBoxResult
Dim cNum As Integer
'error statement
On Error GoTo errHandler:
'check for values
If Reg1.Value = "" Or Reg3.Value = "" Then
MsgBox "There is not data to delete"
Exit Sub
End If
'give the user a chance to change their mind
cDelete = MsgBox("Are you sure that you want to delete this training", vbYesNo + vbDefaultButton2, "Are you sure??")
If cDelete = vbYes Then
'find the row
Set findvalue = Sheet2.Range("V:V").Find(What:=Reg99, LookIn:=xlValues)
findvalue.EntireRow.Delete
End If
'clear the controls
cNum = 20
For X = 1 To cNum
Me.Controls("Reg" & X).Value = ""
Next
'run the filter
AdvFilter
'add the values to 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
Sub Setit()
'disable,clear values and change the back color of all controls
cNum = 20
For X = 1 To cNum
Me.Controls("Reg" & X).Value = ""
Next
'clear the criteria range
With Sheet2
.Range("Z7").Value = ""
.Range("AA7").Value = ""
.Range("AB7").Value = ""
.Range("Y7").Value = ""
End With
'clear the listbox
lstLookup.RowSource = ""
'clear the controls
With Me
.txtLookup.Value = ""
.cboDepartment.Value = ""
.cboStart.Value = ""
End With
End Sub
Private Sub Reg7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'check for date value
Me.Reg7 = Format(Me.Reg7, "dd/mm/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 Reg17_Change()
'add values to criteria
'Me.Reg17.Value = Format(Me.Reg17.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.Reg17.Value = Format(Sheet3.Range("Q7").Value, "dd/mm/yy")
'End Sub
'Private Sub Reg17_Change()
'Me.Reg17 = Format(Me.Reg17, "dd/mm/yy")
'End Sub
Private Sub UserForm_Initialize()
'format the control
Me.Reg7 = Format(Me.Reg7, "dd/mm/yy")
Me.Reg17 = Format(Me.Reg17, "dd/mm/yy")
'clear the listbox
Me.lstLookup.RowSource = ""
AdvFilter
With Application
Me.Left = .Left
Me.Top = .Top
Me.Height = .Height
Me.Width = .Width
End With
End Sub
Private Sub cmdClear_Click()
'call macro Setit to clear values
Setit
End Sub
Private Sub cmdClear2_Click()
'call macro Setit to clear values
Setit
End Sub
Private Sub cmdClose_Click()
'close userform
Unload Me
End Sub