Count Items in listbox on userform

YasserKhalil · Mar 19, 2016

Hello everyone
I have working file that counts the instance of missions between two dates
Have a look on the attachment ..
The results are displayed ( Name & Number of missions) between two dates ..
The results are not sorted .. I need to get the results sorted from greater number of missions to less
For example: show the form and click "Press" command button that will put dates in textbox1 and textbox2
The results are 2 / 1 / 21 .. I need to display results like that 21 / 2 / 1
Hope it is clear

Chihiro · Mar 19, 2016

For some reason, Listbox doesn't populate for me in the sample. I haven't looked into the code much.

See link. This should show you how to do it.

http://dailydoseofexcel.com/archives/2004/05/24/sorting-a-multicolumn-listbox/

Or post#2 in below link.
http://www.excelforum.com/excel-pro...ulticolumn-listbox-in-userform-5-columns.html

YasserKhalil · Mar 20, 2016

Thank you Mr. Chihiro but the links are about sorting the listbox (multicolumn) ..
Thanks for trying to help me all the time

shrivallabha · Mar 20, 2016

Do you mean number of rows?

Code:

Msgbox Me.ListBox1.ListCount

YasserKhalil · Mar 20, 2016

Thanks for all
There is a sample workbook with working code that do the task partially ..
Just need the items displayed in the list box to be sorted according to the number of missions.. Please try the attachment
For those who can not download the sample
Put two textboxes and two command buttons and one list box
This code would be put

Code:

Private Sub CommandButton1_Click()
    Dim D As Date, D1 As Date
    Dim Tx$, I&, T$, II&, LR&, R&
    Dim Rng As Range, Rn As Range, My_Rn As Range
    Dim Am, V, Y, Ar
    Dim Sh As Worksheet

    Application.DisplayAlerts = False
    On Error Resume Next
    Set Sh = Sheets(1)

    If Not IsDate(TextBox1) Then MsgBox "Enter Start Date": TextBox1.SetFocus: Exit Sub
    If Not IsDate(TextBox2) Then MsgBox "Enter End Date": TextBox2.SetFocus: Exit Sub

    D = DateSerial(Year(TextBox1), Month(TextBox1), Day(TextBox1))
    D1 = DateSerial(Year(TextBox2), Month(TextBox2), Day(TextBox2))
    LR = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    II = 2

    With CreateObject("scripting.dictionary")
        For R = 2 To LR
            If IsDate(Sh.Cells(R, 6)) Then
                V = DateSerial(Year(Sh.Cells(R, 6)), Month(Sh.Cells(R, 6)), Day(Sh.Cells(R, 6)))
                If V >= D And V <= D1 Then
                    Set Rn = Sh.Range("A" & R)
                    Tx = Sh.Cells(R, 1)
                    If Not Rn Is Nothing Then
                        If My_Rn Is Nothing Then Set My_Rn = Rn Else Set My_Rn = Union(My_Rn, Rn)
                    End If
                    Y = .Item(Tx)
                End If
            End If
        Next R

        Ar = Split(Join(.Keys, ","), ",")

        For I = LBound(Ar) To UBound(Ar)
            If Application.CountIf(My_Rn, Ar(I)) > 0 Then
                T = T & Ar(I) & " : " & " Missions ( " & Application.CountIf(My_Rn, Ar(I)) & " )" & vbNewLine
            End If
        Next

        With UserForm1
            .ListBox1.List = Application.Transpose(Split(T, vbNewLine))
        End With

        Set Rn = Nothing: Set My_Rn = Nothing: Set Rng = Nothing

        On Error GoTo 0
    End With
End Sub

Private Sub CommandButton2_Click()
    Me.TextBox1.Value = Format(Range("F2"), "dd/mm/yyyy")
    Me.TextBox2.Value = Format(Range("F25"), "dd/mm/yyyy")
End Sub

And this is the range A1:J25

Code:

Name    ID    Time    Other    Notes    Date    Type    Deliver    Arrival    Total
Gamal    672        S1    N1    13/11/2015        2:55    3:14    00:19
Ahmed    672        S2    N2    14/11/2015        2:55    2:57    00:02
Yasser    672        S3    N3    15/11/2015        2:55    2:57    00:02
Yasser    672        S4    N4    16/11/2015        2:55    2:57    00:02
Yasser    672        S5    N5    17/11/2015        2:55    2:59    00:04
Yasser    672        S6    N6    18/11/2015        2:59    3:59    01:00
Yasser    672        S7    N7    19/11/2015        2:55    2:57    00:02
Yasser    672        S8    N8    20/11/2015        2:55    2:57    00:02
Yasser    672        S9    N9    21/11/2015        2:55    2:57    00:02
Yasser    672        S10    N10    22/11/2015        2:55    2:57    00:02
Yasser    672        S11    N11    23/11/2015        2:55    2:57    00:02
Yasser    672        S12    N12    24/11/2015        2:55    2:57    00:02
Yasser    672        S13    N13    25/11/2015        2:55    2:59    00:04
Yasser    672        S14    N14    26/11/2015        2:55    2:57    00:02
Yasser    672        S15    N15    27/11/2015        2:55    2:57    00:02
Yasser    672        S16    N16    28/11/2015        2:55    2:57    00:02
Yasser    672        S17    N17    29/11/2015        2:55    2:57    00:02
Yasser    672        S18    N18    30/11/2015        2:55    3:05    00:10
Yasser    672        S19    N19    01/12/2015        2:55    2:57    00:02
Yasser    672        S20    N20    02/12/2015        2:55    2:57    00:02
Yasser    672        S21    N21    03/12/2015        2:55    3:07    00:12
Yasser    672        S22    N22    04/12/2015        2:55    2:57    00:02
Gamal    672        S23    N23    05/12/2015        2:55    2:57    00:02
Yasser    672        S24    N24    06/12/2015        2:55    2:57    00:02

Marc L · Mar 20, 2016

Code:

Private Sub CommandButton1_Click()
    Dim cMis As New Collection, D1 As Date, D2 As Date, N&, R&, V, VD, VN
    If Not IsDate(TextBox1) Then MsgBox "Enter Start Date": TextBox1.SetFocus: Exit Sub
    If Not IsDate(TextBox2) Then MsgBox "Enter End Date": TextBox2.SetFocus: Exit Sub
        UserForm1.ListBox1.Clear
        D1 = CDate(TextBox1)
        D2 = CDate(TextBox2)
    With Sheet1.Cells(1).CurrentRegion.Columns
        VN = .Item(1).Value
        VD = .Item(6).Value
    End With
        On Error Resume Next
    For R = 1 To UBound(VN)
        If VarType(VD(R, 1)) = vbDate Then
            If VD(R, 1) >= D1 And VD(R, 1) <= D2 Then
                  Err.Clear
                    cMis.Add Array(VN(R, 1), 1), VN(R, 1)
                If Err.Number = 457 Then
                            V = cMis(VN(R, 1))
                         V(1) = V(1) + 1
                         cMis.Remove V(0)
                    For N = 1 To cMis.Count
                        If V(1) > cMis(N)(1) Then cMis.Add V, V(0), N: Exit For
                    Next
                           If N > cMis.Count Then cMis.Add V, V(0)
                End If
            End If
        End If
    Next
        On Error GoTo 0
    If cMis.Count Then
        For Each V In cMis
            UserForm1.ListBox1.AddItem V(0) & " :  missions ( " & V(1) & " )"
        Next
            Set cMis = New Collection
    Else
        MsgBox "No match !"
    End If
            Set cMis = Nothing
End Sub

jindon · Mar 20, 2016

Code:

Private Sub CommandButton1_Click()
    Dim D As Date, D1 As Date
    Dim e, SL As Object, a() As String, i As Long
    If Not IsDate(TextBox1) Then MsgBox "Enter Start Date": TextBox1.SetFocus: Exit Sub
    If Not IsDate(TextBox2) Then MsgBox "Enter End Date": TextBox2.SetFocus: Exit Sub
    D = DateSerial(Right$(TextBox1, 4), Mid$(TextBox1, 4, 2), Left$(TextBox1, 2))
    D1 = DateSerial(Right$(TextBox2, 4), Mid$(TextBox2, 4, 2), Left$(TextBox2, 2))
    Set SL = CreateObject("System.Collections.SortedList")
    With Sheets("sheet1").Cells(1).CurrentRegion
        For Each e In Filter(.Parent.Evaluate("transpose(if((" & .Columns("f").Address & ">=" & CLng(D) & ")*(" & _
                .Columns("f").Address & "<=" & CLng(D1) & ")," & .Columns(1).Address & ",char(2)))"), Chr(2), 0)
            SL(e) = SL(e) + 1
        Next
    End With
    If SL.Count = 0 Then Exit Sub
    ReDim a(SL.Count - 1)
    For i = 0 To SL.Count - 1
        a(i) = SL.GetKey(i) & " : Mission (" & SL.GetByIndex(i) & ")"
    Next
    Me.ListBox1.List = a
End Sub

Marc L · Mar 20, 2016

To jindon :

YasserKhalil said:
I need to get the results sorted from greater number of missions to less
The results are 2 / 1 / 21 .. I need to display results like that 21 / 2 / 1

Not a big concern, just by reversing the loop …

Your DateSerial way can't work with D/MM/YYYY date format
(error #13 on my side), the reason why I prefer to use CDate …

YasserKhalil · Mar 20, 2016

Thank you very much for these great solutions
Mr. MarcL it is working like charm ..
Mr. Jindon It is great and working but I need the results in reversed not from least to greatest but from greatest to least (I tried to edit but failed)

jindon · Mar 20, 2016

1) Dates in Excel is a nightmare... and it only works that way here, so you need to adjust it as needed.

2) Sort Greater to smaller...

Code:

Private Sub CommandButton1_Click()
    Dim D As Date, D1 As Date
    Dim e, dic As Object, a() As String, i As Long, x
    If Not IsDate(TextBox1) Then MsgBox "Enter Start Date": TextBox1.SetFocus: Exit Sub
    If Not IsDate(TextBox2) Then MsgBox "Enter End Date": TextBox2.SetFocus: Exit Sub
    D = DateSerial(Right$(TextBox1, 4), Mid$(TextBox1, 4, 2), Left$(TextBox1, 2))
    D1 = DateSerial(Right$(TextBox2, 4), Mid$(TextBox2, 4, 2), Left$(TextBox2, 2))
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("sheet1").Cells(1).CurrentRegion
        For Each e In Filter(.Parent.Evaluate("transpose(if((" & .Columns("f").Address & ">=" & CLng(D) & ")*(" & _
                .Columns("f").Address & "<=" & CLng(D1) & ")," & .Columns(1).Address & ",char(2)))"), Chr(2), 0)
            dic(e) = dic(e) + 1
        Next
    End With
    If dic.Count = 0 Then Exit Sub
    ReDim a(dic.Count - 1)
    For i = 0 To dic.Count - 1
        x = Application.Max(dic.items)
        x = Application.Match(x, dic.items, 0)
        a(i) = dic.keys()(x - 1) & " : Mission (" & dic.items()(x - 1) & ")"
        dic.Remove dic.keys()(x - 1)
    Next
    Me.ListBox1.List = a
End Sub

YasserKhalil · Mar 21, 2016

Thank you very much for this great help
Now it is working well and as expected
Best and kind regards

YasserKhalil · Mar 22, 2016

Hello Experts
I am sorry for disturbing you again in this issue
I need an additional request
I have added four textboxes and I need to put in textbox3 (the greatest name related to value) and in textbox5 (the value related to that name)
The expected as in the sample : (Yasser) in textbox3 and the value (21) in textbox5

The same as for textbox4 and textbox6 but for the least .. as in the example :
(Ahmed) in textbo4 and the value (1) in textbox6
Thanks a lot for great help from you

Marc L · Mar 22, 2016

Hi !

Changes needed are at beginner level !

Code:

Private Sub CommandButton1_Click()
    Dim cMis As New Collection, D1 As Date, D2 As Date, N&, R&, V, VD, VN
    If Not IsDate(TextBox1) Then MsgBox "Enter Start Date": TextBox1.SetFocus: Exit Sub
    If Not IsDate(TextBox2) Then MsgBox "Enter End Date": TextBox2.SetFocus: Exit Sub
        UserForm1.ListBox1.Clear
        For N = 3 To 6:  Me.Controls("TextBox" & N).Value = "":  Next
        D1 = CDate(TextBox1)
        D2 = CDate(TextBox2)
    With Sheet1.Cells(1).CurrentRegion.Columns
        VN = .Item(1).Value
        VD = .Item(6).Value
    End With
        On Error Resume Next
    For R = 1 To UBound(VN)
        If VarType(VD(R, 1)) = vbDate Then
            If VD(R, 1) >= D1 And VD(R, 1) <= D2 Then
                  Err.Clear
                    cMis.Add Array(VN(R, 1), 1), VN(R, 1)
                If Err.Number = 457 Then
                            V = cMis(VN(R, 1))
                         V(1) = V(1) + 1
                         cMis.Remove V(0)
                    For N = 1 To cMis.Count
                       If V(1) > cMis(N)(1) Then cMis.Add V, V(0), N: Exit For
                    Next
                          If N > cMis.Count Then cMis.Add V, V(0)
                End If
            End If
        End If
    Next
        On Error GoTo 0
    If cMis.Count Then
            N = 0
        For Each V In cMis
            UserForm1.ListBox1.AddItem V(0) & " :  missions ( " & V(1) & " )"
                        N = N + 1
            Select Case N
              Case 1:                         TextBox3.Value = V(0): TextBox5.Value = V(1)
              Case cMis.Count:  If N > 1 Then TextBox4.Value = V(0): TextBox6.Value = V(1)
            End Select
        Next
            Set cMis = New Collection
    Else
        MsgBox "No match !"
    End If
            Set cMis = Nothing
End Sub

YasserKhalil · Mar 22, 2016

Thanks a lot Mr. MarcL for great code
In fact I am very weak at dealing with userforms and I am just a learner not professional
Best and kind regards

Count Items in listbox on userform

YasserKhalil

Well-Known Member

Attachments

Chihiro

Excel Ninja

YasserKhalil

Well-Known Member

shrivallabha

Excel Ninja

YasserKhalil

Well-Known Member

Marc L

Excel Ninja

jindon

Well-Known Member

Marc L

Excel Ninja

YasserKhalil

Well-Known Member

jindon

Well-Known Member

YasserKhalil

Well-Known Member

YasserKhalil

Well-Known Member

Attachments

Marc L

Excel Ninja

YasserKhalil

Well-Known Member