trying to build an array from a userform listbox

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 "

Code:

---

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

---

Code:

---

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

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

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

Code:

---

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

---

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

Code:

---

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

---

Attachment 14211 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

Code:

---

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

---

You might do something like this

Code:

---

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."

---

Code:

---

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

---

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)