We help IT Professionals succeed at work.
Get Started

Excel VBA - Listbox Values Populated Based on Tabstrip Selection + Listbox Selection Based on Checkbox Selection

Mark Delorme
Mark Delorme asked
on
391 Views
Last Modified: 2016-08-31
I realize this might be a little to ambitious to even be posting, but here goes:

I have a userform with a tabstrip that offers each of the available departments.  The tabstrip selection dictates the population of listbox items (employees), based on different named ranges (for each department, while removing any blank values in the ranges).

I've managed to write a working code such that as the tabstrip selection (deparment) changes and the listbox values (employees) change accordingly, selecting the current listbox items (employees) and clicking the "Send" command button will loop through each listbox item and send a personalized email to each of the selected employees.  This is working perfectly.

My intent is to be able to allow selection of whole departments, rather than having to click a single department, select all users, complete the personalized email form fields, click send, and then have to repeat this whole process for a separate department.  Example:  if the email is intended to be sent out company-wide and have every employee in every department receive the same email.

One thing I've also accomplished is the ability to have checkboxes placed next to each tabstrip item (departments) act in such a way that selecting the checkbox will change the tabstrip value to the designated department and display each of the corresponding listbox employee names, already selected.  This only functions for a single department, but I feel as though I'm getting closer to my end goal.

My question is whether someone can suggest a way to have each of these checkboxes function simultaneously, such that if, for example, 5 out of the 8 checkboxes are selected, those 5 corresponding tabstrips (departments) and listboxes will become simultaneously selected and therefore recognized by my "Send" command button.

I've provided a couple screenshots of the userform, and also my code below...

Email_Form1.png
Email_Form2.png
Email_Form3.png
Email_Form4.png
Dim User_Count As Long
Dim DeptData As Range

        Dim CCI As Long
        Dim CEM As Long
        Dim MAN As Long
        Dim OTH As Long
        Dim PUR As Long
        Dim MAR As Long
        Dim TAM As Long
        Dim WAR As Long

Private Sub cbCCI_Click()

Dim U As Long

If Me.cbCCI.Value = True Then
    Me.DEPT_GROUPS.Value = 0
        For U = 0 To lbUsers.ListCount - 1
            lbUsers.Selected(U) = cbCCI
        Next U
End If

End Sub

Private Sub cbCEM_Click()

Dim U As Long

If Me.cbCEM.Value = True Then
    Me.DEPT_GROUPS.Value = 1
        For U = 0 To lbUsers.ListCount - 1
            lbUsers.Selected(U) = cbCEM
        Next U
End If

End Sub

Private Sub cbMAN_Click()

Dim U As Long

If Me.cbMAN.Value = True Then
    Me.DEPT_GROUPS.Value = 2
        For U = 0 To lbUsers.ListCount - 1
            lbUsers.Selected(U) = cbMAN
        Next U
End If

End Sub

Private Sub cbOTH_Click()

Dim U As Long

If Me.cbOTH.Value = True Then
    Me.DEPT_GROUPS.Value = 3
        For U = 0 To lbUsers.ListCount - 1
            lbUsers.Selected(U) = cbOTH
        Next U
End If

End Sub

Private Sub cbPUR_Click()

Dim U As Long

If Me.cbPUR.Value = True Then
    Me.DEPT_GROUPS.Value = 4
        For U = 0 To lbUsers.ListCount - 1
            lbUsers.Selected(U) = cbPUR
        Next U
End If

End Sub

Private Sub cbMAR_Click()

Dim U As Long

If Me.cbMAR.Value = True Then
    Me.DEPT_GROUPS.Value = 5
        For U = 0 To lbUsers.ListCount - 1
            lbUsers.Selected(U) = cbMAR
        Next U
End If

End Sub

Private Sub cbTAM_Click()

Dim U As Long

If Me.cbTAM.Value = True Then
    Me.DEPT_GROUPS.Value = 6
        For U = 0 To lbUsers.ListCount - 1
            lbUsers.Selected(U) = cbTAM
        Next U
End If

End Sub

Private Sub cbWAR_Click()

Dim U As Long

If Me.cbWAR.Value = True Then
    Me.DEPT_GROUPS.Value = 7
        For U = 0 To lbUsers.ListCount - 1
            lbUsers.Selected(U) = cbWAR
        Next U
End If

End Sub

Private Sub DEPT_GROUPS_Change()

If Me.DEPT_GROUPS.Value = 0 Then
    With Me.lbUsers
        .RowSource = ""
        Set DeptData = Sheet1.Range("CCI_MDI")
        .List = DeptData.Cells.Value
        For CCI = .ListCount - 1 To 0 Step -1
            If .List(CCI, 1) = "" Then
                .RemoveItem CCI
            End If
        Next CCI
    End With
End If

If Me.DEPT_GROUPS.Value = 1 Then
    With Me.lbUsers
        .RowSource = ""
        Set DeptData = Sheet1.Range("CE_MARKETING")
        .List = DeptData.Cells.Value
        For CEM = .ListCount - 1 To 0 Step -1
            If .List(CEM, 1) = "" Then
                .RemoveItem CEM
            End If
        Next CEM
    End With
End If

If Me.DEPT_GROUPS.Value = 2 Then
    With Me.lbUsers
        .RowSource = ""
        Set DeptData = Sheet1.Range("MANAGEMENT")
        .List = DeptData.Cells.Value
        For MAN = .ListCount - 1 To 0 Step -1
            If .List(MAN, 1) = "" Then
                .RemoveItem MAN
            End If
        Next MAN
    End With
End If

If Me.DEPT_GROUPS.Value = 3 Then
    With Me.lbUsers
        .RowSource = ""
        Set DeptData = Sheet1.Range("OTHER")
        .List = DeptData.Cells.Value
        For OTH = .ListCount - 1 To 0 Step -1
            If .List(OTH, 1) = "" Then
                .RemoveItem OTH
            End If
        Next OTH
    End With
End If

If Me.DEPT_GROUPS.Value = 4 Then
    With Me.lbUsers
        .RowSource = ""
        Set DeptData = Sheet1.Range("PURCHASING")
        .List = DeptData.Cells.Value
        For PUR = .ListCount - 1 To 0 Step -1
            If .List(PUR, 1) = "" Then
                .RemoveItem PUR
            End If
        Next PUR
    End With
End If

If Me.DEPT_GROUPS.Value = 5 Then
    With Me.lbUsers
        .RowSource = ""
        Set DeptData = Sheet1.Range("SALES_MAR")
        .List = DeptData.Cells.Value
        For MAR = .ListCount - 1 To 0 Step -1
            If .List(MAR, 1) = "" Then
                .RemoveItem MAR
            End If
        Next MAR
    End With
End If

If Me.DEPT_GROUPS.Value = 6 Then
    With Me.lbUsers
        .RowSource = ""
        Set DeptData = Sheet1.Range("SALES_TAM")
        .List = DeptData.Cells.Value
        For TAM = .ListCount - 1 To 0 Step -1
            If .List(TAM, 1) = "" Then
                .RemoveItem TAM
            End If
        Next TAM
    End With
End If

If Me.DEPT_GROUPS.Value = 7 Then
    With Me.lbUsers
        .RowSource = ""
        Set DeptData = Sheet1.Range("WAREHOUSE")
        .List = DeptData.Cells.Value
        For WAR = .ListCount - 1 To 0 Step -1
            If .List(WAR, 1) = "" Then
                .RemoveItem WAR
            End If
        Next WAR
    End With
End If

End Sub

Private Sub cmdSend_Click()

Dim User_Name As String
Dim User_Pass As String
Dim User_Mail As String
Dim Mail_Subject As String
Dim Mail_Body As String

    Dim U As Integer

'If Me.lbUsers.ListCount = 0 Then
'        MsgBox "No email recipients have been selected from the user list.", vbOKOnly + vbExclamation, "INVALID ENTRY"
'        Exit Sub
'End If
    
If Me.txtSubject.text = "" Then
        MsgBox "Please include an email subject heading.", vbOKOnly + vbExclamation, "INVALID ENTRY"
        Exit Sub
End If

If MsgBox("Send email notifications to selected users?", vbOKCancel, "CONFIRM EMAIL") = vbCancel Then
        Exit Sub
End If

    For U = 0 To Me.lbUsers.ListCount - 1
        If Me.lbUsers.Selected(U) Then
            User_Name = Me.lbUsers.List(U, 0)
            User_Pass = Me.lbUsers.List(U, 1)
            User_Mail = Me.lbUsers.List(U, 2)

            Mail_Subject = Me.txtSubject.text
            Mail_Body = "Hello " & User_Name & "," & Sheet1.Range("G1") & "<strong>" & User_Pass & "</strong>" & _
            "<p>" & Me.txtBody.text & "<p>" & Sheet1.Range("G2")

            Call SendEmail(User_Mail, Mail_Subject, Mail_Body)

        End If
    Next U


Unload Me

End Sub

Sub SendEmail(User_Mail As String, Mail_Subject As String, Mail_Body As String)

Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)

    olMail.To = User_Mail
    olMail.Subject = Mail_Subject
    olMail.BodyFormat = olFormatHTML
    olMail.HTMLBody = Mail_Body
    olMail.Send

End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Open in new window

Comment
Watch Question
Analyst Assistant
CERTIFIED EXPERT
Distinguished Expert 2020
Commented:
This problem has been solved!
Unlock 1 Answer and 8 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE