PDA

View Full Version : [SOLVED] trying to build an array from a userform listbox



mperrah
08-11-2015, 11:38 AM
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
08-11-2015, 11:43 AM
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
08-11-2015, 11:49 AM
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
08-11-2015, 12:32 PM
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
08-18-2015, 04:43 PM
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


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
08-18-2015, 09:18 PM
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
08-19-2015, 01:07 AM
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,uboun d(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
08-19-2015, 07:52 AM
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)