Userform with listbox and checkboxes

Dstars21

New Member
Joined
Oct 5, 2019
Messages
8
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!

1574313752021.png
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
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.

VBA Code:
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
 
Upvote 0
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
ABC
1Dist Rec
2CustomerDaysAmount
3Bill6154.6
4Bill9166.08
5Carl1116.93
6Steve6106.98
7Miguel8172.45
8Miguel3159.63
9
10
11Avg DaysAvg Amount
125.5146.11
Sheet3
Cell Formulas
RangeFormula
B12:C12B12=ROUND(SUBTOTAL(1,B3:B8),2)
 
Upvote 0
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:

VBA Code:
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
 
Upvote 0
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.

VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,490
Messages
6,113,957
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top