User Defined Types || Excel VBA Master Class || 3.4f

Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video. Source code will be presented in the order of the sections within the video.

Intro

Type typeEmployeeRecord
    FirstName As String
    LastName As String
    LengthOfServiceInYears As Long
    IsPermanent As Boolean
End Type

Sub CaptureEmployeeData_UDTs()

    Dim employee As typeEmployeeRecord
    Dim FullName As String
    Dim EligibleForExtendedLeave As Boolean
    Dim EligibleForStaffBenefits As Boolean

    employee.FirstName = wsIntro.Range("C4").Value
    employee.LastName = wsIntro.Range("C6").Value
    employee.LengthOfServiceInYears = wsIntro.Range("F4").Value
    employee.IsPermanent = wsIntro.Range("F6").Value

    FullName = employee.FirstName & " " & employee.LastName

    If employee.LengthOfServiceInYears > 5 Then EligibleForExtendedLeave = True

    If (employee.IsPermanent) Then EligibleForStaffBenefits = True

End Sub

Basics

Creating & Nesting UDTs

Type NameDetails
    First As String
    Last As String
End Type

Type typeEmployeeRecord
    EmployeeName As NameDetails
    ManagerName As NameDetails
    LengthOfServiceInYears As Long
    IsPermanent As Boolean
End Type

Sub CaptureEmployeeData()

    Dim employee As typeEmployeeRecord
    With employee
        .EmployeeName.First = wsIntro.Range("C4").Value
        .EmployeeName.Last = wsIntro.Range("C6").Value
        .LengthOfServiceInYears = wsIntro.Range("F4").Value
        .IsPermanent = wsIntro.Range("F6").Value
        .ManagerName.First = wsIntro.Range("C8").Value
        .ManagerName.Last = wsIntro.Range("F8").Value
    End With
    Dim employment As String
    If employee.IsPermanent = True Then
        employment = "Permanent"
        Else
        employment = "Contracted"
    End If
    Debug.Print employee.EmployeeName.First & " " & employee.EmployeeName.Last & " has worked with us for " & _
                    CStr(employee.LengthOfServiceInYears) & " years and is a " & employment & " employee, reporting to " & _
                    employee.ManagerName.First & " " & employee.ManagerName.Last & "."

End Sub

Pass UDT as an Argument

Type typeEmployeeName
    FirstName As String
    LastName As String
    EmailId As String
End Type

Sub DisplayEmailId()
    Dim newEmployee As typeEmployeeName
    newEmployee.FirstName = "James"
    newEmployee.LastName = "Lemon"
    '[email protected]
'    newEmployee.EmailId = newEmployee.FirstName & "." & newEmployee.LastName & "@pierpoint.com"
'    newEmployee.EmailId = BuildEmailId(newEmployee)
    BuildEmailId newEmployee
    Debug.Print newEmployee.EmailId
End Sub

'Function BuildEmailId(ByRef fEmployee As typeEmployeeName) As String
'    BuildEmailId = fEmployee.FirstName & "." & fEmployee.LastName & "@pierpoint.com"
'End Function

Sub BuildEmailId(ByRef fEmployee As typeEmployeeName)
    fEmployee.EmailId = fEmployee.FirstName & "." & fEmployee.LastName & "@pierpoint.com"
End Sub

Return Value from Function as a UDT

Const Email As String = "[email protected]"

Public Type typeEmployeeNameSplit
    Success As Boolean
    FirstName As String
    LastName As String
End Type

Sub PrintEmployeeNames()
    Dim employee As typeEmployeeNameSplit
    employee = GetNames(Email)
    If employee.Success = True Then
        Debug.Print employee.FirstName & " " & employee.LastName
        Else
        Debug.Print "Invalid Email Id"
    End If
End Sub


Function GetNames(fEmailId As String) As typeEmployeeNameSplit
    Dim arrBothNames() As String, arrSingleNames() As String
    arrBothNames = Split(fEmailId, "@")
    If UBound(arrBothNames) = 0 Then
        GetNames.Success = False
        Exit Function
    End If
    GetNames.Success = True
    arrSingleNames = Split(arrBothNames(0), ".")
    GetNames.FirstName = arrSingleNames(0)
    GetNames.LastName = arrSingleNames(1)
End Function

Use Object Within a UDT

Const Threshold As Double = 20000

Type Outstanding
    CustomerName As String
    Amount As Double
    SortSheet As Worksheet
End Type

Sub SortOutstandingCustomers()
    Dim outCust As Outstanding
    Dim lrow As Long, i As Long
    wsAlert.Rows("2:" & Rows.Count).ClearContents
    wsWatchList.Rows("2:" & Rows.Count).ClearContents
    For i = 2 To wsData.Range("A1").CurrentRegion.Rows.Count
        outCust.CustomerName = wsData.Range("A" & i).Value
        outCust.Amount = wsData.Range("B" & i).Value
        If outCust.Amount > Threshold Then
            Set outCust.SortSheet = wsAlert
            Else
            Set outCust.SortSheet = wsWatchList
        End If
        lrow = outCust.SortSheet.Range("A" & outCust.SortSheet.Rows.Count).End(xlUp).Row + 1
        outCust.SortSheet.Cells(lrow, 1).Value = outCust.CustomerName
        outCust.SortSheet.Cells(lrow, 2).Value = outCust.Amount
    Next i
End Sub

Declare Array as a UDT

Const Threshold As Double = 20000

Type Outstanding
    CustomerName As String
    Amount As Double
End Type

Sub FilterAlertCustomers()
    Dim lenData As Long
    lenData = wsData.Range("A1").CurrentRegion.Rows.Count
    Dim lenArray As Long
    lenArray = Application.WorksheetFunction.CountIf(wsData.Range("B2:B" & lenData), ">" & Threshold)
    Dim alertCustomers() As Outstanding
    ReDim alertCustomers(1 To lenArray) As Outstanding
    Dim dataCustomer As Outstanding
    Dim i As Long, arrCount As Long
    arrCount = 1
    For i = 2 To lenData
        dataCustomer.CustomerName = wsData.Range("A" & i).Value
        dataCustomer.Amount = wsData.Range("B" & i).Value
        If dataCustomer.Amount > Threshold Then
            alertCustomers(arrCount).CustomerName = dataCustomer.CustomerName
            alertCustomers(arrCount).Amount = dataCustomer.Amount
            arrCount = arrCount + 1
        End If
    Next i
    wsAlert.Rows("2:" & Rows.Count).ClearContents
    For i = 1 To UBound(alertCustomers)
        wsAlert.Range("A" & i + 1).Value = alertCustomers(i).CustomerName
        wsAlert.Range("B" & i + 1).Value = alertCustomers(i).Amount
    Next i
End Sub