How to Control Data Capture with a VBA Form in Excel

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:Data Capture

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 menuInsert A Userform

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

Designing the formIn 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

Comments are closed.