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”.
To produce the following form, which writes to an underlying spreadsheet. The workbook used in this exercise can be found here:
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”:
“Defaults” will populate some combo boxes. Copy the following text into cell A1 of “Defaults”:
|Asset Management||Asset Management||IT|
|Insurance||Asset Management||Portfolio Management|
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
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.
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