excelvbauserform

Dependent dropbox on excel userform


Screenshot of the UserForm

I would like to change the the dropdown box "Service" ( values in Sheets"Lookup" columns G,H,I) to depending dropdown based on values from dropdown box "Department" ( values in Sheets"Staff" column A) and if possible generate unique ID for new record being added....

enter image description here

Module

Option Explicit

Public Function GetRange() As Range

    ' Get the data range from the Staff worksheet
    Set GetRange = shStaff.Range("A2").CurrentRegion
    ' remove the header from the range by moving the range down one row and
    ' then removing the last row.
    Set GetRange = GetRange.Offset(1).Resize(GetRange.Rows.Count - 1)

End Function

' Delete the row from the staff worksheet
Public Sub DeleteSelectedRow(ByVal row As Long)
    ' Offset moves the range a given number of rows
    shStaff.Range("A2").Offset(row).EntireRow.Delete
End Sub

' Return the list of countries from the Lookup table
Public Function GetServices() As Variant
    GetServices = shLookup.ListObjects("tbCountry").DataBodyRange.Value
End Function

' Return the list of departments from the Lookup table
Public Function GetDepartments() As Variant
    GetDepartments = shLookup.ListObjects("tbDepartment").DataBodyRange.Value
End Function

' Create the ID for a new record
Public Function GetNewID() As Long
    GetNewID = 1 + WorksheetFunction.Max(shStaff.Range("A2").CurrentRegion.columns(1))
End Function


formStaffDetailsEdit

Option Explicit



Private m_currentRow As Long

Public Property Let currentRow(ByVal newCurrentRow As Long)
    m_currentRow = newCurrentRow
End Property

' USERFORM EVENTS
Private Sub UserForm_Activate()
    Call FillComboboxes
    Call LoadData
End Sub

Private Sub buttonClose_Click()
    Unload Me
End Sub

Private Sub buttonUpdate_Click()
    Call WriteDataToSheet
End Sub

' HELPER FUNCTION/SUBS
Public Sub FillComboboxes()

    ' Fill the comboboxes
    Me.comboService.List = GetServices()
    Me.comboDepartment.List = GetDepartments()
    
End Sub

' Load data from the worksheet to the controls
Public Sub LoadData()
    
    ' Offset moves the range the numbers of rows specified by m_currentRow
    With shStaff.Range("A2").Offset(m_currentRow)
        textboxID.Value = .Cells(1, 1).Value
        textboxFirstname.Value = .Cells(1, 2).Value
        textboxLastname.Value = .Cells(1, 3).Value
        comboService.Value = .Cells(1, 4).Value
        OptionFulltime.Value = IIf(.Cells(1, 5).Value = "Full-time", True, False)
        OptionParttime.Value = IIf(.Cells(1, 5).Value = "Part-time", True, False)
        comboDepartment.Value = .Cells(1, 6).Value
    End With
    
End Sub

' Write the data to the worksheet from the controls
Private Function WriteDataToSheet()

    If MsgBox("Do you want to save this record?", vbYesNo, "Save record") = vbYes Then

        ' Offset moves the range by the numbers of rows specified by m_currentRow
        With shStaff.Range("A2").Offset(m_currentRow)

            ' copy the data to the controls
            .Cells(1, 1).Value = textboxID.Value
            .Cells(1, 2).Value = textboxFirstname.Value
            .Cells(1, 3).Value = textboxLastname.Value
            .Cells(1, 4).Value = comboService.Value
            .Cells(1, 5).Value = IIf(OptionFulltime.Value = True, "Full-time", "Part-time")
            .Cells(1, 6).Value = comboDepartment.Value

        End With

    End If

End Function

formStaffDetailsNew

Option Explicit




' USERFORM EVENTS
Private Sub UserForm_Initialize()
    Call CreateNewID
    Call InitializeControls
End Sub

Private Sub buttonClose_Click()
    Unload Me
End Sub

' Save the data
Private Sub buttonSave_Click()
        
    If MsgBox("Do you want to save this record?:", vbYesNo, "Save record") = vbYes Then
        ' Add the new staff member details to the worksheet
        Call WriteDataToSheet
        ' Remove data from textboxes
        Call EmptyTextboxes
        ' Create the new ID for the staff member
        Call CreateNewID
    End If
    
End Sub

' HELPER FUNCTION/SUBS
Private Sub CreateNewID()
    textboxID.Value = GetNewID()
End Sub

' Save the record and clear the data from the controls
Private Function WriteDataToSheet()

    Dim newRow As Long
    With shStaff

        ' Get the first blank row of data
        newRow = .Cells(.Rows.Count, 1).End(xlUp).row + 1
        
        ' Write the data
        .Cells(newRow, 1).Value = textboxID.Value
        .Cells(newRow, 2).Value = textboxFirstname.Value
        .Cells(newRow, 3).Value = textboxLastname.Value
        .Cells(newRow, 4).Value = comboService.Value
        .Cells(newRow, 5).Value = IIf(OptionFulltime.Value = True, "Full-time", "Part-time")
        .Cells(newRow, 6).Value = comboDepartment.Value

    End With

End Function

' Clear data from the textbox controls
Public Sub EmptyTextboxes()
    
    Dim c As Control
    ' Read through all the controls
    For Each c In Me.Controls
        If TypeName(c) = "TextBox" Then
            c.Value = ""
        End If
    Next
    
End Sub

Public Sub InitializeControls()

    ' Fill the comboboxes and select the first item
    Me.comboService.List = GetServices()
    Me.comboService.ListIndex = 0
    Me.comboDepartment.List = GetDepartments()
    Me.comboDepartment.ListIndex = 0
    
    OptionFulltime.Value = True
    
End Sub

Appreciate any help....


Solution

  • What about OOP?

    Let's create a department object with collection of services (insert new Class Module and name it cDepartment):

    Option Explicit
    
    Dim sDepName As String
    Dim cServices As New Collection
    
    
    Public Property Get DepName() As String
        DepName = sDepName
    End Property
    
    Public Property Let DepName(sName As String)
        sDepName = sName
    End Property
    
    Public Property Get Services() As Collection
        Set Services = cServices
    End Property
    
    Public Property Set Services(oServices As Collection)
        Set cServices = oServices
    End Property
    

    Then add below code to your UserForm (change the names of controls according to your needs):

    Option Explicit
    
    Dim deps As New Collection
    
    
    Private Sub CmbDepartments_Change()
        Dim dep As cDepartment, oSer As Variant
        
        Me.CmbServices.Clear
        
        Set dep = deps(Me.CmbDepartments.ListIndex + 1)
        For Each oSer In dep.Services
            Me.CmbServices.AddItem CStr(oSer)
        Next oSer
        
        Set dep = Nothing
    End Sub
    
    Private Sub UserForm_Initialize()
        Dim wbk As Workbook, wsh As Worksheet
        Dim c As Long, r As Long
        Dim dep As cDepartment
        
        Set wbk = ThisWorkbook
        Set wsh = wbk.Worksheets(1)
        
        For c = 0 To 2
            r = 1
            Set dep = New cDepartment
            dep.DepName = wsh.Range("G" & r).Offset(ColumnOffset:=c)
            deps.Add dep
            Me.CmbDepartments.AddItem dep.DepName
            r = 2
            Do While wsh.Range("G" & r).Offset(ColumnOffset:=c) <> ""
                dep.Services.Add wsh.Range("G" & r).Offset(ColumnOffset:=c)
                r = r + 1
            Loop
        Next c
        
        Set dep = Nothing
        Set wsh = Nothing
        Set wbk = Nothing
    End Sub
    

    Result:

    enter image description here

    Try it.