VBA Excel Userform Database
VBA Excel Userform Database
Contents [show]
Overview
In this project we will be using a Excel userform database that will run a complete staff allocation system. This truly is an awesome
application.
You will be able to allocate staff to a job number and make them available again after the job is completed and check the status of all of
your staff at any time.
It would be especially suited to somebody who is sending staff to multiple jobs in a day and having them then return to their base.
The complete application is run from a userform and all information is archived to keep a complete history of all work that staff has been
sent to.
You can also create a PDF copy of a particular job number or certain job numbers during the day.
Name Formula
ArchiveSheet =Archive!$A$1
Staff_ListSheet =Staff_List!$A$1
Job_AllocationSheet =Jobs_Allocation!$A$1
Skills =OFFSET(Jobs_Allocation!$P$7,,,COUNTA(Jobs_Allocation!$P$7:$P$100))
Trades =OFFSET(Staff_List!$R$6,1,,COUNTA(Staff_List!$R$6:$R$9994),9)
There are 2 other ranges that we will create as we need them.
One is for the archiving “Booked”
The other is for the print area “PDFrng”
Creating the Userform
Add a userform and add the controls from the illustration below.
Make sure to use the right control type and assign the exact name shown.
Note: Reg2 and Reg3 should have the properties set to invisible.
Test the userform with the run button or by pushing the F5 key.
Note: We will be assigning the items to cboBooked as the userform initialises as we do not want this information to change.
Combobox criteria
As you will see in a moment in our advanced filter macro we have multiple criteria in fact 2 criteria. This combo box is one of the criteria.
It allows for three options. First to filter our database by those who are Booked, second to filter the database by those who are
Available, and third a blank option that will allow for all to be shown with the filter. I would suggest that you look at this code very
carefully because here you will find that we are excluding and including other controls depending on our selection. As an example if we
would choose the criteria "Available" which means we are bringing staff back to base then we would not want to assign a job number so
we disable that feature and change the colour of the control to stop our staff from making this error.
Private Sub cboBooked_Change()
'enable and disable buttons based on selection
If Me.cboBooked.Value = "Available" Then
'disable Job numbers
Me.txtJob.Enabled = False
'change the button back color
Me.txtJob.BackColor = RGB(192, 192, 192)
'disable skills list
Me.cboSkills.Enabled = False
'change the button back color
Me.cboSkills.BackColor = RGB(192, 192, 192)
ElseIf Me.cboBooked.Value = "Booked" Then
'enable Job numbers
Me.txtJob.Enabled = True
'change the button back color
Me.txtJob.BackColor = RGB(255, 255, 255)
'enable skills
Me.cboSkills.Enabled = True
'change the button back color
Me.cboSkills.BackColor = RGB(255, 255, 255)
End If
End Sub
Before we go any further we need to go to our Assorted Module and add a if you macros that are
necessary at this stage of our development.Do not copy the code that you see the below into the userform
, it goes in the Assorted Module.
The code below is for the add and edit and delete features of this application at the bottom
of the userform.
Adding new staff members
If you have completed the Staff Database project then this section of the application will be a breeze you. I have used the code from
that application with a couple of small modifications in order to add edit and delete staff from our Staff Allocator Application.
Please take the time to read through the code below and try to figure out what is happening.
Private Sub cmdAdd_Click()
Application.ScreenUpdating = False
Dim nextrow As Range
'error handler
On Error GoTo errHandler:
'set the next row in the database
Set nextrow = Sheet2.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)
'check for values in the first 4 controls
If Me.Reg1.Value = "" Or Me.Reg4.Value = "" Or Me.Reg5.Value = "" Then
MsgBox "You need to add the skill and first and last names"
Exit Sub
End If
'check for duplicate payroll numbers
If WorksheetFunction.CountIf(Sheet2.Range("G:G"), Me.Reg4.Value) > 0 Then
MsgBox "This staff member already exists"
Exit Sub
End If
'number of controls to loop through
cNum = 9
'add the data to the database
For x = 1 To cNum
nextrow = Me.Controls("Reg" & x).Value
Set nextrow = nextrow.Offset(0, 1)
Next
'clear the controls
For x = 1 To cNum
Me.Controls("Reg" & x).Value = ""
Next
'sort the database
Sortit
'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
Option Add
Private Sub optAdd_Click()
'what to do when the add option button is clicked
'allow the adding of an ID
Me.Reg4.Enabled = True
'change the back color
Me.Reg4.BackColor = RGB(255, 255, 255)
'disable the edit button
Me.cmdEdit.Enabled = False
'enable the add button
Me.cmdAdd.Enabled = True
End Sub
Option Edit
Private Sub optEdit_Click()
'what ot do when the edit option is selected
'disable the ID
Me.Reg4.Enabled = False
'change the ID color background
Me.Reg4.BackColor = RGB(192, 192, 192)
'enable the edit button
Me.cmdEdit.Enabled = True
'disable the add button
Me.cmdAdd.Enabled = False
End Sub
Private Sub lstSelector_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
Dim cPayroll As String
Dim I As Integer
Dim findvalue
Dim cNum As Integer
'error block
On Error GoTo errHandler:
'get the select value from the listbox
For I = 0 To lstSelector.ListCount- 1
If lstSelector.Selected(I) = True Then
cPayroll = lstSelector.List(I, 3)
End If
Next I
'find the payroll number
Set findvalue = Sheet2.Range("G:G").Find(What:=cPayroll, LookIn:=xlValues).Offset(0, -3)
'add the database values to the userform
cNum = 9
For x = 1 To cNum
Me.Controls("Reg" & x).Value = findvalue
Set findvalue = findvalue.Offset(0, 1)
Next
'disable adding
Me.cmdAdd.Enabled = False
Me.cmdEdit.Enabled = True
'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
Deleting staff
What does this code do?
Make sure the test that all of these features and functions are working for you in your
application.