User capture into a spreadsheet is difficult to police; the entry point could be anywhere, and even locking of some cells provides no focus on the part of the user. A User Form with validation can provide an orderly channel for data capture into a spreadsheet.
The article assumes the reader has the Developer ribbon displayed and is familiar with the VBA Editor. If not, please Google “Excel Developer Tab” or “Excel Code Window”.
Objective
To produce the following form, which writes to an underlying spreadsheet. The workbook used in this exercise can be found here:
The Worksheets
Two tabs are required, Open a new workbook and name the first tab “Data”, and the second “Defaults”.
“Data” will hold user input. Copy the following heading text into cell A1 of “Data”:
| Title | LastName | FirstName | StartDate | BusUnit | Department |
“Defaults” will populate some combo boxes. Copy the following text into cell A1 of “Defaults”:
| BusUnit | BusUnit | Department |
| Asset Management | Asset Management | IT |
| Insurance | Asset Management | Portfolio Management |
| Asset Management | Administration | |
| Asset Management | Analysis | |
| Insurance | Marketing | |
| Insurance | Agency | |
| Insurance | Pensions | |
| Insurance | IT | |
| Insurance | Human Resources | |
| Insurance | Accounts |
The Form
Open the VBA code window and create a form called frmCapture.
If the Project Explorer or Properties window are not visible, select them in the View menu
Start-up Code
To display the capture form when the workbook opens, insert a new module and paste the following code therein, along with several global variables:
Public strTitle As String Public strFirstName As String Public strLastName As String Public strBusUnit As String Public strDept As String Public strDate As String Sub Auto_Open() ‘runs automatically when the workbook opens frmCapture.Show End Sub
Designing the form
In the View menu, select Toolbox if it is not visible. This gives us the controls for our form.
Place three text boxes and three combo boxes onto the form, along with buttons, named cmdSave and cmdClose.
It is good practice to name all controls except labels, so they can be easily referenced in code. For this exercise, set the Name property of each control as shown. The BorderStyle property for each has been set to Single, giving a flat appearance.
Some versions of Excel do not have a calendar control so we will merely check that any Start Date entry is valid for your region.
Excel Corruption Problems
At this point it’s politic to point out that, on occasion, Excel files become corrupt during the Save process. The problem here is that it is the source file that gets corrupted, and if you have closed it during the course of the Save, your work is lost. Ideally, you should have a tool that can fix corrupted Excel files.
Loading the Form
Double_click on the form and, into the code window that opens, paste the code below:
The Form Code
Private Sub UserForm_Activate()
Call ClearControls
'load today's date as a guide to the user
txtDate = Format(Now(), "yyyy-mm-dd")
'Load the Title combo box
Me.cboTitle.AddItem "Mr"
cboTitle.AddItem "Mrs"
cboTitle.AddItem "Ms"
cboTitle.AddItem "Miss" 'etc
'Load the Business Unit combo box
Sheets("Defaults").Activate
Sheets("Defaults").Range("A2").Select
Do While ActiveCell > ""
Me.cboBusUnit.AddItem ActiveCell
Range("A" & ActiveCell.Row + 1).Select
Loop
End Sub
Sub ClearControls(Optional dbo As String)
Dim Ctl As Object
For Each Ctl In frmCapture.Controls
Select Case TypeName(Ctl)
Case "TextBox"
Ctl.Text = vbNullString
Case "ComboBox"
Ctl.Text = vbNullString 'clear all cbos
End Select
Next Ctl
End Sub
Private Sub txtLastName_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'When leaving the field, capitalise it properly
txtLastName = WorksheetFunction.Proper(txtLastName)
End Sub
Private Sub txtFirstName_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtFirstName = WorksheetFunction.Proper(txtFirstName)
End Sub
Private Sub cboBusUnit_Change()
'Load relevant departments pertaining to the selected Business Unit
Dim strBusUnit As String
strBusUnit = cboBusUnit
cboDept.Clear
Sheets("Defaults").Activate
Sheets("Defaults").Range("B2").Select
Do While ActiveCell > ""
If ActiveCell = strBusUnit Then
Me.cboDept.AddItem ActiveCell.Offset(0, 1).Value
End If
Range("B" & ActiveCell.Row + 1).Select
Loop
End Sub
Private Sub cmdClose_Click()
'Close and save workbook
Workbooks("10.Controlling Data Capture with a Form2.xlsm").Close SaveChanges:=True
End Sub
Private Sub cmdSave_Click()
strTitle = cboTitle
strFirstName = txtFirstName
strLastName = txtLastName
strBusUnit = cboBusUnit
strDept = cboDept
strDate = txtDate
'Check if data is OK.
If strTitle = "" Or strFirstName = "" Or strLastName = "" Or strDate = "" Or strBusUnit = "" Or strDept = "" Then
MsgBox "Please complete all fields"
Exit Sub
End If
If Not IsDate(strDate) Then
MsgBox "Please enter the Start Date as yyyy-mm-dd"
Exit Sub
Else
strDate = Format(strDate, "Short Date")
End If
'Find the Data sheet's insertion point
Sheets("Data").Activate
Sheets("Data").Range("A1").Select
If ActiveCell.Offset(1, 0) = "" Then
nRow = 2
Else
Selection.End(xlDown).Select
nRow = ActiveCell.Row + 1
End If
On Error GoTo labErr
'Write to the Data sheet
Cells(nRow, 1) = strTitle
Cells(nRow, 2) = strFirstName
Cells(nRow, 3) = strLastName
Cells(nRow, 4) = strDate
Cells(nRow, 5) = strBusUnit
Cells(nRow, 6) = strDept
Call ClearControls '("cboDept")
Sheets("Data").Activate
txtDate = Format(Now(), "yyyy-mm-dd")
Application.ScreenUpdating = True
MsgBox "Successfully updated"
Exit Sub
labErr:
MsgBox Err.Description
Application.ScreenUpdating = True
End Sub
Save the workbook as an XLSM and close it. Reopen it and test that the code works as expected.
Author Introduction:
Felix Hooker is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including repair rar file damage and sql recovery software products. For more information visit www.datanumen.com
Leave a Reply