trying to build an array from a userform listbox

[mperrah]

I could use a second (or sixth... I wear glasses) set of eyes on this.

Ultimate goal is let user know when there are more than 5 if the same number in the 3rd column of a userform listbox....

I thought to build an array from the listbox,
pulling just unique values,
then compare the unique array items against the listbox items
and get a sum count for matches
then show a msgbox if any item has more than 5 matches...

after several tries this gets the farthest, but errors on "

a_lbBills(t, c) = .List(r, c)

Sub makeDupListInArray()
Dim t, r, c, x, lbCnt As Integer
Dim myLb
Dim a_lbBills()
        
Set myLb = CalendarOpts.lbBills
With myLb
    t = 1
    For r = 0 To .ListCount - 1
        ReDim a_lbBills(0 To r, 0 To 2)
        For c = 0 To 2
            If .List(r, 2) <> .List(r + 1, 2) Then
            'ReDim Preserve a_lbBills(0 To t, 0 To 2)
                a_lbBills(t, c) = .List(r, c)
            End If
        Next c
        t = t + 1
    Next r
            
    For x = 0 To UBound(a_lbBills)
        For r = 0 To .ListCount - 1
            If a_lbBills(x, 2) = .List(r, 2) Then
                lbCnt = lbCnt + 1
            End If
        Next r
            If lbCnt = 6 Then
            .ListIndex = r
                MsgBox ("Too Many bills on one day")
            End If
    Next x
End With

End Sub

any and all help is greatly appreciated
-mark

[mperrah]

note:
the list is not sorted and matching items are not always adjacent vertically,
its a 3 column listbox. the value I'm matching is a 1 or 2 digit number (day of month) in the right most column

[mperrah]

I have this working on the sheet, but want to match this on the userform...

Sub makeDupListOnSheet()
' mark perrah 6/9/15 combining duplicates
Dim aSum, lr, lrF, i, t, x As Long
Dim aPart As Variant

    lr = Cells(Rows.Count, 1).End(xlUp).Row
        
    Range("M1:P30").ClearContents
        
    Range("D2:D" & lr).Copy Destination:=Range("M1")
    ActiveSheet.Range("$M$1:$M" & lr).RemoveDuplicates Columns:=1, Header:=xlNo
    
    lrF = Cells(Rows.Count, "M").End(xlUp).Row
        ReDim aPart(1 To lrF)
        For x = 1 To lrF
            aPart(x) = Cells(x, "M").Value
        Next x
        
        For t = LBound(aPart) To UBound(aPart)
            aSum = 0
            For i = 2 To lr
                If aPart(t) = Cells(i, 4) Then
                    aSum = aSum + 1
                    Cells(t, "O").Value = Cells(i, 4).Value
                End If
            Next i
            
            Cells(t, "P").Value = aSum
        Next t
    
    Range("M1:M" & lr).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    For x = 1 To lrF
    If Cells(x, "P").Value > 5 Then
    MsgBox ("You have more then 5 bills on a signle day")
    End If
    Next x
       
End Sub

[mperrah]

I have this for the Userform ,
but It miscalculates if I have changed the contents of the userform after it Initializes
i have a sub that can add, remove or modify the values in the listbox.
After changes in the listbox, this sub seems to count based on the initial values.
Is there a way to force this sub to check what is currently in the listbox,
rather than use the state at initialization

Sub test_5in1_UF()
' when adding new bill or making calendar from UF test for 5 bills per day
Dim lbDay, lrUF, mCnt, t As Long
Dim ufCal, temp1
Dim nDate
Set ufCal = CalendarOpts.lbBills

With ufCal
    lrUF = .ListCount - 1
    
    For lbDay = 0 To lrUF
        mCnt = 0
        temp1 = .List(lbDay, 2)
        For t = 1 To lrUF
            If .List(t, 2) = temp1 Then
                mCnt = mCnt + 1
                If .List(t, 2) > 5 Then
                    .ListIndex = t
                    MsgBox ("You are adding more then 5 bills for a single day.")
                    Exit Sub
                End If
            End If
        Next t
    Next lbDay
    End With
End Sub

[mperrah]

BillCalendar_10_issues.xlsm file so far

Basically trying to count number of dupes in listbox, (3rd column of 3)
if 6 or more dupes then select the 6th one and let user change value (have a sub to change value already)

I am trying to build an array from listbox without duplicates (maybe sort first?)
then compare the array to the list and select the 6th match.

I have an array being built from the listbox to see where the problem is.
My method leaves blank spaces and duplicates...
Not attached to this method, but struggling for ideas

Sub makeDupListInArray()
Dim t, r, x, lbCnt, ufBillsCnt As Integer
Dim a_lbBills()
Dim c, txt
        
    With CalendarOpts.lbBills
    t = 1
    ufBillsCnt = .ListCount - 1
    ReDim a_lbBills(1 To ufBillsCnt, 1)
    
    For r = 0 To ufBillsCnt
   ' ReDim Preserve a_lbBills(1 To t + 2, 1)
        If r < ufBillsCnt Then p = 1 Else p = -1
            If .List(r, 2) <> .List(r + p, 2) And .List(r, 2) <> "" Then
            
                a_lbBills(t, 1) = .List(r, 2)
                t = t + 1
            End If
    Next r
            
    For x = LBound(a_lbBills) To UBound(a_lbBills)
        For r = 0 To ufBillsCnt
            If a_lbBills(x, 1) = .List(r, 2) Then
                lbCnt = lbCnt + 1
            End If
        Next r
            If lbCnt = 6 Then
                '.ListIndex = r
                MsgBox ("Too Many bills on one day")
            End If
    Next x
End With

For c = LBound(a_lbBills) To UBound(a_lbBills)
txt = txt & a_lbBills(c, 1) & vbCrLf
Next c

MsgBox txt

End Sub

[mikerickson]

You might do something like this

Dim i As Long, maxCount as Long, maxDup as long
Dim myArray() As Long

ReDim myArray(1 to 31)
With ListBox1
    For i = 0 to .ListCount -1
        myArray(Val(.List(i, 2))) = myArray(Val(.List(i, 2))) + 1
        if maxCount < myArray(Val(.List(i, 2))) then
            maxCount = myArray(Val(.List(i,2)))
            maxDup = Val(.List(i, 2))
        End If
    Next i
End With

MsgBox "The number " & maxDup & " is repeated " & maxCount & " times."

[snb]

Sub M_snb()
  with createobject("scripting.dictionary")
      for j=0 to ubound(listbox1.list)
        .item(listbox1.list(j,ubound(listbox1.list,2)))=.item(listbox1.list(j,ubound(listbox1.list,2)))+1
        if .item(listbox1.list(j,ubound(listbox1.list,2)))>5 then 
           msgbox "too many bills on day " & listbox1.list(j,ubound(listbox1.list,2))
           exit sub
        end if
     next
  end with
End Sub

[mperrah]

Its like Christmas, Ive been struggling for a while and now I get 2 awesome solutions.
I'll try to not shoot my eye out. (Christmas Story Movie reference...)

Thank you snb and Mikerickson (like your avatar by the way)