CODEWITHSUNDEEP
ms-accessvba
bd528
bd528

Reputation: 886

Counting and returning duplicates from Listbox

I have a listbox (Listbox1) in MS Access 2016 with 1 column - ActualDate.

This column contains numerous dates, some of which are duplicated.

The rowsource for this listbox is 

Set rs = CurrentDb.OpenRecordset("SELECT q.ActualDate FROM TBLQUOTESNEW q WHERE q.ActualDate >= #12/01/2017# order by q.ActualDate")

I need to populate another listbox (Listbox2) on the same form, that has 2 columns - ActualDate and Count - with Count being the number of selected rows from Listbox1 containing the date.

So Listbox1 could be :-

13/01/2017
13/01/2017
14/01/2017
14/01/2017

If all 4 rows were selected, Listbox2 should return

13/01/2017    2
14/01/2017    2

I'm not sure on the best method to achieve this. I've been able to create an array with the unique dates, but from there I am stumped.

Upvotes: 0

Views: 492

Answers (2)

Erik A
Erik A

Reputation: 32642

You can use the following subroutine:

Public Sub MoveListBoxItems(lstDestination As ListBox, lstSource As ListBox)
    Dim intListItem As Long
    Dim lastItem As String
    Dim itemAmount As Long
    'Set these using the property pane, then remove them from the VBA
    lstDestination.RowSource = ""
    lstDestination.RowSourceType = "Value List"
    lstDestination.ColumnCount = 2
    For intListItem = 0 To lstSource.ListCount - 1 'iterate through the whole list
        If lstSource.Selected(intListItem) Then 'If the item is selected
            If lstSource.ItemData(intListItem) = lastItem Then 'If the current item is equal to the last one
                itemAmount = itemAmount + 1 'Increment the amount by 1
            Else
                If itemAmount <> 0 Then 'If it isn't a non-occuring list item (first iteration
                    lstDestination.RowSource = lstDestination.RowSource & """" & lastItem & """;""" & itemAmount & """;"
                End If 'Add the item
                lastItem = lstSource.ItemData(intListItem) 'Last item = current item, amount = 1
                itemAmount = 1
            End If
        End If
    Next intListItem
    If itemAmount <> 0 Then 'If it isn't a non-occuring list item
        lstDestination.RowSource = lstDestination.RowSource & """" & lastItem & """;""" & itemAmount & """;"
    End If 'Add the last item
End Sub

Call it like this: MoveListBoxItems Me.Listbox2, Me.Listbox1

Note that it carries some assumptions, namely: the list must be ordered, the list must not contain any quotes (else you will need to add quote escaping)

Upvotes: 1

Sergey S.
Sergey S.

Reputation: 6336

I would use a subform instead if listbox. Subform based on temporary table with additional column "Selected", user selects records using checkboxes. In this case will be very easy to display second listbox or subform based on grouping query from temporary table

Upvotes: 0

Related Questions