Userform with listbox and checkboxes

[Dstars21]

Hello! I am trying to create a user form that makes a user select a name from a Listbox and two options from checkboxes and returns the average of "days" and "amount" for that name selected from the listbox . I'm new to VBA and having trouble setting up the code to do so. Does anyone have any pointers? My userform is shown below, any help is appreciated!

 

[lrobbo314]

It looks like your data is in a table, so that's how I coded it. If your data isn't in a table you can turn it into one and the code should work. Just make sure your table name matches the one in the code.

I have 2 subs listed below. The first is when the userform is activated. It just adds the names to the listbox.

The second is on the button click event and it does the calculations and displays the results.

Let me know if you have any questions.

Private Sub CommandButton1_Click()
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim LO As ListObject: Set LO = ActiveSheet.ListObjects("Table1")
Dim res As String: res = vbNullString

If Me.CheckBox1 Or Me.CheckBox2 Then
    Application.ScreenUpdating = False
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) Then
            If Not AL.contains(Me.ListBox1.List(i)) Then AL.Add Me.ListBox1.List(i)
        End If
    Next i
    
    LO.Range.AutoFilter Field:=1, Criteria1:=Array(AL.toarray), Operator:=xlFilterValues
    
    If Me.CheckBox1 Then res = Round(Evaluate("=Subtotal(1, " & LO.DataBodyRange.Columns(2).Address & ")"), 2) & " days"
    If Me.CheckBox2 Then
        If Len(res) > 0 Then res = res & vbLf
        res = res & FormatCurrency(Evaluate("=Subtotal(1, " & LO.DataBodyRange.Columns(3).Address & ")"))
    End If
    
    MsgBox res
    LO.Range.AutoFilter
    Application.ScreenUpdating = True
Else
    MsgBox "Nothing Selected"
End If

End Sub

Private Sub UserForm_Activate()
Dim LO As ListObject: Set LO = ActiveSheet.ListObjects("Table1")
Dim ar() As Variant: ar = LO.DataBodyRange.Value
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(ar)
    If Not SD.exists(ar(i, 1)) Then
        SD.Add ar(i, 1), Nothing
        Me.ListBox1.AddItem ar(i, 1)
    End If
Next i
End Sub

 

[lrobbo314]

Honestly, I am not a fan of userforms.

A much simpler native way of doing it would just be to add a slicer to your table. Set the slicer to the customer names. This will filter the table then just have a couple of subtotal formulas somewhere on the sheet. See below.

Book1
	A	B	C
1	Dist Rec
2	Customer	Days	Amount
3	Bill	6	154.6
4	Bill	9	166.08
5	Carl	1	116.93
6	Steve	6	106.98
7	Miguel	8	172.45
8	Miguel	3	159.63
9
10
11		Avg Days	Avg Amount
12		5.5	146.11
Sheet3

Cell Formulas
Range	Formula
B12:C12	B12	=ROUND(SUBTOTAL(1,B3:B8),2)

 

[Dstars21]

Hey - thanks for the help, but i'm pretty new to Vba so im having trouble following that code. do you have any advice as to how i could use the code i already have ot solve it?

What i've got so far on my code is:

Private Sub BtnCancel_Click()
MsgBox ("Report Cancelled")
Unload FrmCust
End Sub



Private Sub BtnOk_Click()

Dim customer As Range

'For Each customer In allcustomers

    

If ListBoxCustlist.ListIndex = -1 Then
  MsgBox "No Item was selected"
Else
 
End If




End Sub

Private Sub UserForm_Initialize()

' Fill the listbox with each user's name
    
   Dim cell As Range

'Load to ListBox

  FrmCust.ListBoxCustlist.MultiSelect = fmMultiSelectSingle 'allows only one selection
 
  For Each cell In Worksheets("Data").Range("A3:A283")
    ListBoxCustlist.AddItem cell.Value
  Next cell
  
    

End Sub

 

[lrobbo314]

I tried to simplify it a bit. I am still using an array list because we need a way to make sure that you don't have duplicate names in your listbox. I have commented the code as much as I could to try to make it more clear.

Let me know if you have any questions.

Private Sub cmd_ok_Click()
Dim cel As Range
Dim r As Range: Set r = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim cnt As Integer
Dim avgDays As Double
Dim avgAmt As Double
Dim cust As String
Dim res As String

If Me.chk_Amt Or Me.chk_Days Then 'Check if either is selected, if selected the code returns true

    For i = 0 To Me.lb_custList.ListCount - 1 'Loop through listbox to find selected item
        If Me.lb_custList.Selected(i) Then
            cust = Me.lb_custList.List(i) 'If found, set cust var to value and exit loop
            Exit For
        End If
    Next i
    
    If cust <> vbNullString Then ' check to make sure that cust variable has a value
        For Each cel In r 'loop through range
            If cel.Value = cust Then 'if it matches cust then
                cnt = cnt + 1 'increment count
                If Me.chk_Days Then avgDays = avgDays + cel.Offset(, 1).Value 'add days value
                If Me.chk_Amt Then avgAmt = avgAmt + cel.Offset(, 2).Value 'add amt value
            End If
        Next cel
    End If
    
    If Me.chk_Days Then res = Round(avgDays / cnt, 2) & " days" 'if days is checked then add avg to res string
    If Me.chk_Amt Then 'if amt is checked then
        If Len(res) > 0 Then
            res = res & vbLf & FormatCurrency(avgAmt / cnt, 2) 'if days was also checked then add a carriage return and the amt avg
        Else
            res = FormatCurrency(avgAmt / cnt, 2) 'otherwise, just add the amt avg
        End If
    End If
Else
    res = "Nothing Selected"
End If

MsgBox res 'display results

End Sub

Private Sub UserForm_Initialize()
Dim cel As Range
Dim r As Range: Set r = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) 'You can set the range manually, doing it this way makes it dynamic, i.e. you can add rows to your data w/o changing the code
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList") 'You need to have some way of not having duplicates, array lists can do this

For Each cel In r
    If Not AL.contains(cel.Value) Then 'check if arraylist has cel value
        AL.Add cel.Value 'if not, add it to the array list
        Me.lb_custList.AddItem cel.Value 'then add it to the listbox
    End If
Next cel
End Sub

 

[Dstars21]

ok this helps a lot. thanks so much for the help!