Userforms - the best thing ever

Userform - Hide, Show, and Unload
user form contains a textbox and a button
 
    Private Sub CommandButton1_Click()
        Me.Hide
    End Sub
    
module contains
 
    Public Sub openForm1()
        UserForm1.Show
    End Sub
    
two buttons on worksheet
 
    Private Sub CommandButton1_Click()
        'UserForm1.Show
        openForm1
    End Sub

    Private Sub CommandButton2_Click()
        Unload UserForm1
    End Sub
    
Top

Index

Sample Database and Creating a Data Entry Form
ternary coin-flip function
 
        =IF(RANDBETWEEN(0, 1) = 0, "A", "I")
    
MultiPage is Excel's version of a tabbed control
lecture builds data import UserForm
Top

Index

Fill Status Combobox with Rowsource when Userform Starts - 2 methods
programmically
 
    Private Sub UserForm_Initialize()
        Me.statusComboBox.AddItem "A"
        Me.statusComboBox.AddItem "I"
    End Sub
    
set RowSource property to named grouping
Top

Index

New Employee Data Entry Form
 
    Private Sub saveNewButton_Click()
        Dim ws
        Set ws = ThisWorkbook.Sheets("emp")
    
        nextRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

        ws.Cells(nextRow, 1) = Me.empIdTextBox
        ws.Cells(nextRow, 2) = Me.firstNameTextBox
        ws.Cells(nextRow, 3) = Me.lastNameTextBox
        ws.Cells(nextRow, 4) = Me.address1TextBox
        ws.Cells(nextRow, 5) = Me.cityTextBox
        ws.Cells(nextRow, 6) = Me.stateTextBox
        ws.Cells(nextRow, 7) = Me.zipCodeTextBox
        ws.Cells(nextRow, 8) = Me.phoneTextBox
        ws.Cells(nextRow, 9) = Me.statusComboBox
        ws.Cells(nextRow, 10) = Me.emailTextBox
        ws.Cells(nextRow, 11) = Me.websiteTextBox
    End Sub
    
Top

Index

Format Textbox Numbers as Numerals, Clearing Form on Submission
 
    Private Sub saveNewButton_Click()
        ...
        ' converts to int
        ws.Cells(nextRow, 7) = Me.zipCodeTextBox + 0
        ...
        ' clear form
        Me.empIdTextBox = ""
        Me.firstNameTextBox = ""
        Me.lastNameTextBox = ""
        Me.address1TextBox = ""
        Me.cityTextBox = ""
        Me.stateTextBox = ""
        Me.zipCodeTextBox = ""
        Me.phoneTextBox = ""
        Me.statusComboBox = ""
        Me.emailTextBox = ""
        Me.websiteTextBox = ""
    End Sub
    
Top

Index

Avoid Duplicate Employee ID and Other Automation Tricks
 
    Private Sub saveNewButton_Click()

        ' check required fields
        If Me.firstNameTextBox = "" Or lastNameTextBox = "" Or empIdTextBox = "" Then
            MsgBox "First name, last name, and employee ID are required", vbCritical
            Exit Sub
        End If

        Dim ws
        Set ws = ThisWorkbook.Sheets("emp")
    
        lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
        nextRow = lastRow + 1

        ' check for duplicate employee ID
        For x = 2 To lastRow
            If Me.empIdTextBox = ws.Cells(x, 1) Then
                MsgBox "Employee ID has already been used"
                Exit Sub
            End If
        Next x

        ...
    End Sub
    
Top

Index

Edit Mode for Employee Database
in the module a public boolean is added as a work-around
 
    Public myOnOff As Boolean
    
when in the edit mode the boolean is set to true and set to false at the end of the saveButton_Click event handler
 
    Private Sub saveButton_Click()
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets("emp")
    
        ' check required fields
        If Me.firstNameTextBox = "" Or lastNameTextBox = "" Or empIdTextBox = "" Then
            MsgBox "First name, last name, and employee ID are required", vbCritical
            Exit Sub
        End If

        workingRow = -1
        If Me.changeButton.Caption = "Change" Then
            lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
            workingRow = lastRow + 1

            ' check for duplicate employee ID
            For x = 2 To lastRow
                If Me.empIdTextBox = ws.Cells(x, 1) & "" Then
                    MsgBox "Employee ID has already been used"
                    Exit Sub
                End If
            Next x
            ws.Cells(workingRow, 1) = Me.empIdTextBox
        Else
        myOnOff = True
            workingRow = Me.rowLabel
            ws.Cells(workingRow, 1) = Me.empIdComboBox
        End If

        ws.Cells(workingRow, 2) = Me.firstNameTextBox
        ws.Cells(workingRow, 3) = Me.lastNameTextBox
        ws.Cells(workingRow, 4) = Me.address1TextBox
        ws.Cells(workingRow, 5) = Me.cityTextBox
        ws.Cells(workingRow, 6) = Me.stateTextBox.Value
        ' converts to int
        ws.Cells(workingRow, 7) = Me.zipCodeTextBox + 0
        ws.Cells(workingRow, 8) = Me.phoneTextBox
        ws.Cells(workingRow, 9) = Me.statusComboBox
        ws.Cells(workingRow, 10) = Me.emailTextBox
        ws.Cells(workingRow, 11) = Me.websiteTextBox
        Call clearForm
        myOnOff = False
    End Sub
    
every time the underlying row changes the empIdComboBox_Change event handler is fired
this event reloads the various controls with the original values of the row
when the boolean is set to true the change event returns immediately without reloading the controls
 
    Private Sub empIdComboBox_Change()
        If myOnOff = True Then Exit Sub
    
        Dim ws
        Set ws = ThisWorkbook.Sheets("emp")
        lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
        empId = Me.empIdComboBox

        For x = 2 To lastRow
            ' convert cell value to text
            If ws.Cells(x, 1) & "" = empId Then
                Me.rowLabel = x
                Me.rowLabel.Visible = True
                Me.empIdTextBox = ws.Cells(x, 1)
                Me.firstNameTextBox = ws.Cells(x, 2)
                Me.lastNameTextBox = ws.Cells(x, 3)
                Me.address1TextBox = ws.Cells(x, 4)
                Me.cityTextBox = ws.Cells(x, 5)
                Me.stateTextBox.Text = ws.Cells(x, 6)
                Me.zipCodeTextBox = ws.Cells(x, 7)
                Me.phoneTextBox = ws.Cells(x, 8)
                Me.statusComboBox = ws.Cells(x, 9)
                Me.emailTextBox = ws.Cells(x, 10)
                Me.websiteTextBox = ws.Cells(x, 11)
                Exit Sub
            End If
        Next x
    End Sub
    
Top

Index

Refreshing Rowsource after Updating Data
after a new entry is made the new entry does not appear in the employee id ComboBox's list because the list was loaded when the form was loaded
to refresh the list so it contains the new entry reset the ComboBox's RowSource property
 
    Private Sub saveButton_Click()
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets("emp")
    
        ' check required fields
        If Me.firstNameTextBox = "" Or lastNameTextBox = "" Or empIdTextBox = "" Then
            MsgBox "First name, last name, and employee ID are required", vbCritical
            Exit Sub
        End If

        workingRow = -1
        If Me.changeButton.Caption = "Change" Then
            lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
            workingRow = lastRow + 1

            ' check for duplicate employee ID
            For x = 2 To lastRow
                If Me.empIdTextBox = ws.Cells(x, 1) & "" Then
                    MsgBox "Employee ID has already been used"
                    Exit Sub
                End If
            Next x
            ws.Cells(workingRow, 1) = Me.empIdTextBox
            Call writeDataToSheet(workingRow, ws)
        ' refresh empIdComboBox RowSource property to shown latest addition
        empIdComboBox.RowSource = vbNullString
        Me.empIdComboBox.RowSource = "empID_table"
        Else
            myOnOff = True
            workingRow = Me.rowLabel
            ws.Cells(workingRow, 1) = Me.empIdComboBox
            Call writeDataToSheet(workingRow, ws)
        End If
        Call clearForm
        myOnOff = False
    End Sub
    
Top

Index

ComboBox Search by Last Name
macro below loads the last name combobox
 
    Sub loadLastNameInfo()
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets("emp")
        lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
        ' clear comboxbox before reloading
        Me.lastNameComboBox.Clear

        For x = 2 To lastRow
            Me.lastNameComboBox.AddItem ws.Cells(x, 3) & ", " & ws.Cells(x, 2)
            Me.lastNameComboBox.List(Me.lastNameComboBox.ListCount - 1, 1) = ws.Cells(x, 1)
        Next x
    End Sub
    
macro is called on initialization
 
    Private Sub UserForm_Initialize()
        Me.statusComboBox.AddItem "A"
        Me.statusComboBox.AddItem "I"
        Call setFormDefaults
        Call loadLastNameInfo
    End Sub
    
and when a new employee is added
 
    Private Sub saveButton_Click()
        ...
        workingRow = -1
        If Me.changeButton.Caption = "Change" Then
            lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
            workingRow = lastRow + 1

            ' check for duplicate employee ID
            For x = 2 To lastRow
                If Me.empIdTextBox = ws.Cells(x, 1) & "" Then
                    MsgBox "Employee ID has already been used"
                    Exit Sub
                End If
            Next x
            ws.Cells(workingRow, 1) = Me.empIdTextBox
            Call writeDataToSheet(workingRow, ws)
            ' refresh empIdComboBox RowSource property to shown latest addition
            Me.empIdComboBox.RowSource = vbNullString
            Me.empIdComboBox.RowSource = "empID_table"
            ' refresh lastNameComboBox RowSource property to shown latest addition
        Call loadLastNameInfo
        Else
            ...
        End If
        Call clearForm
        myOnOff = False
    End Sub
    
Top

Index

Search By Name and ID
 
    Private Sub searchButton_Click()
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets("emp")
        lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
        ' clear previous results
        Me.resultsListBox.Clear
        ' use upper case for both strings
        searchParams = UCase(Me.searchTextBox)
        ' iterate worksheet looking for some sort of match
        For x = 2 To lastRow
            ' look for match
            currentRow = UCase(ws.Cells(x, 1) & " " & Cells(x, 2) & " " & Cells(x, 3))
            ' on match use AddItem to put object in results list box
            If InStr(currentRow, searchParams) <> 0 Then
                Me.resultsListBox.AddItem ws.Cells(x, 3) & ", " & ws.Cells(x, 2)
                Me.resultsListBox.List(Me.resultsListBox.ListCount - 1, 1) = ws.Cells(x, 1)
            End If
        Next x
    End Sub
    
Top

Index

UserForm Report with Filters
 
    Sub employeeReport()
        Dim sourceSheet As Worksheet
        Set sourceSheet = ThisWorkbook.Sheets("emp")
    
        Dim reportSheet As Worksheet
        Set reportSheet = ThisWorkbook.Sheets("empList")
        reportSheet.UsedRange.ClearContents
        reportSheet.Cells(1, 1) = "Employee ID"
        reportSheet.Cells(1, 2) = "Last Name, First Name"
        reportSheet.Cells(1, 3) = "Phone"
        reportSheet.Cells(1, 4) = "Status"
        reportSheet.Cells(1, 5) = "email"
    
    
        lastRow = sourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
        
        reportEmpId = 1
        reportName = 2
        reportPhone = 3
        reportStatus = 4
        reportEmail = 5
    
        sourceEmpId = 1
        sourceFirstName = 2
        sourceLastName = 3
        sourceAddress = 4
        sourceCity = 5
        sourceState = 6
        sourceZipCode = 7
        sourcePhone = 8
        sourceStatus = 9
        sourceEmail = 10
        sourceWeb = 11
    
        reportRow = 2
        For x = 2 To lastRow
            reportSheet.Cells(x, reportEmpId) = sourceSheet.Cells(reportRow, sourceEmpId) & ""
            reportSheet.Cells(x, reportName) = sourceSheet.Cells(reportRow, sourceLastName) & ", " & sourceSheet.Cells(reportRow, sourceFirstName)
            reportSheet.Cells(x, reportPhone) = sourceSheet.Cells(reportRow, sourcePhone)
            reportSheet.Cells(x, reportStatus) = sourceSheet.Cells(reportRow, sourceStatus)
            reportSheet.Cells(x, reportEmail) = sourceSheet.Cells(reportRow, sourceEmail)
        
            reportRow = reportRow + 1
        
        Next x
    End Sub
    
Top

Index

Applying the Dynamic Filters for Reports
 
    Sub employeeReport()
        ...
    
        reportRow = 2
        For x = 2 To lastRow
            stateValue = sourceSheet.Cells(x, 6)
            statusValue = sourceSheet.Cells(x, 9)
        
            If stateValue = Me.stateTextBox And Me.statusComboBox = statusValue Then
                reportSheet.Cells(reportRow, reportEmpId) = sourceSheet.Cells(x, sourceEmpId) & ""
                reportSheet.Cells(reportRow, reportName) = sourceSheet.Cells(x, sourceFirstName) & " " & sourceSheet.Cells(reportRow, sourceLastName)
                reportSheet.Cells(reportRow, reportPhone) = sourceSheet.Cells(x, sourcePhone)
                reportSheet.Cells(reportRow, reportStatus) = sourceSheet.Cells(x, sourceStatus)
                reportSheet.Cells(reportRow, reportEmail) = sourceSheet.Cells(x, sourceEmail)
            
                reportRow = reportRow + 1
            End If
        Next x
    End Sub
    
Top

Index

Clear out Last Report
cleaner than what is used above
 
    Sub employeeReport()
        ...
    
        Dim reportSheet As Worksheet
        Set reportSheet = ThisWorkbook.Sheets("empList")

        reportLastRow = reportSheet.Cells(Rows.Count, 1).End(xlUp).Row
        reportSheet.Range("a2:e" & reportLastRow).ClearContents
    
        ...
    End Sub
    
Top

Index

Report Generation and Aesthetics, Headers, Footers, Repeat Rows etc.
click Print Titles glyph on Page Layout tab
Top

Index

Exercise - Review of Objectives
use change event to calculate the total cost
 
    Private Sub Worksheet_Change(ByVal Target As Range)
        ' only one cell at a time
        If Target.Cells.Count > 1 Then Exit Sub
    
        If Not Intersect(Target, Range("a2:a21")) Is Nothing Then
            If Target = Empty Then Exit Sub
            ' set the price
           Target.Offset(0, 2) = Application.WorksheetFunction.VLookup(Target, ThisWorkbook.Sheets("items").Range("item_table"), 2, 0)
            ' focus on quantity cell
            Target.Offset(0, 1).Select
        ElseIf Not Intersect(Target, Range("b2:c21")) Is Nothing Then
            Cells(Target.Row, 4) = Cells(Target.Row, 2) * Cells(Target.Row, 3)
            Cells(Target.Row + 1, 1).Select
        End If
    End Sub
    
Top

Index

Exercise 1
 
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("a2:a21")) Is Nothing Then
            Target.Offset(0, 2) = Application.WorksheetFunction.VLookup(Target, ThisWorkbook.Sheets("items").Range("item_table"), 2, 0)
        End If
    End Sub
    
Top

Index

Exercise 2
use VLookup function to get the price
 
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("a2:a21")) Is Nothing Then
            Target.Offset(0, 2) = Application.WorksheetFunction.VLookup(Target, ThisWorkbook.Sheets("items").Range("item_table"), 2, 0)
        ElseIf Not Intersect(Target, Range("b2:c1")) Is Nothing Then
            Cells(Target.Row, 4) = Cells(Target.Row, 2) * Cells(Target.Row, 3)
        End If
    End Sub
    
Top

Index

Exercises 3 & 4
 
    Private Sub CommandButton1_Click()
        unitPrice = Me.tbPrice + 0
        itemName = Me.tbItem
    
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets("items")
    
        nextRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        ws.Cells(nextRow, 1) = itemName
        ws.Cells(nextRow, 2) = unitPrice
    
        tbPrice = ""
        tbItem = ""
        Call clearAndHideForm
    End Sub

    Private Sub CommandButton2_Click()
        Call clearAndHideForm
    End Sub

    Sub clearAndHideForm()
        tbPrice = ""
        tbItem = ""
        Me.Hide
    End Sub
    
Top

Index

Bonus Exercises A & B & C
 
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("a2:a21")) Is Nothing Then
            ' if nothing to do exit
            If Target = Empty Then Exit Sub
            ' get the price
            Target.Offset(0, 2) = Application.WorksheetFunction.VLookup(Target, ThisWorkbook.Sheets("items").Range("item_table"), 2, 0)
            ' move to next cell in row
            Target.Offset(0, 1).Select
        ElseIf Not Intersect(Target, Range("b2:c21")) Is Nothing Then
            ' calculate the cost
            Cells(Target.Row, 4) = Cells(Target.Row, 2) * Cells(Target.Row, 3)
            ' move to next row
            Cells(Target.Row + 1, 1).Select
        End If
    End Sub
    
Top

Index

n4jvp.com