PDA

View Full Version : [SOLVED] Filling two listboxes



Olwa
05-18-2017, 04:46 AM
Hi there,
i cant seem to find a solution for this:
Lets say i got the following table and a userform with 2 listboxes. I want the first listbox to be filled with all numbers that passed the check (in this case 012 and 115) and the second one with those that failed at least one (in this case 001, 025, 205). I got as far as filling one textbox with all numbers (without duplicates) but can't seem to figure a way out to fill the listboxes depending on 2 criteria (number and check). Any help would be appreciated!


number
identity
check


001
684
False


001
213
True


001
848
True


012
779
True


012
151
True


025
321
False


115
591
True


205
733
False


205
987
False

MickG
05-18-2017, 08:10 AM
Try this for Listbox1 & 2.


Sub LBox()
Dim Rng As Range, Dn As Range, n As Long, Fd As Boolean
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
For n = 1 To 2
With CreateObject("scripting.dictionary")
Fd = IIf(n = 1, False, True)
For Each Dn In Rng
If Dn.Offset(, 2).Value = Fd Then
.Item(Dn.Value) = Empty
End If
Next Dn
If n = 1 Then
ListBox1.List = Application.Transpose(.Keys)
Else
ListBox2.List = Application.Transpose(.Keys)
End If
End With
Next n
End Sub

GTO
05-18-2017, 09:41 AM
Another try...



Private Sub UserForm_Initialize()
' Late ' Early
Dim DIC As Object ' Scripting.Dictionary
Dim rngData As Range
Dim arrData As Variant
Dim n As Long
Dim Index As Long
Dim Keys As Variant
Dim Items As Variant

With Sheet1 '<--Change to suit

Set rngData = RangeFound(.Range(.Range("A2"), .Cells(.Rows.Count, "C")))

If Not rngData Is Nothing Then

arrData = .Range(.Range("A2"), .Cells(rngData.Row, "C")).Value
Set DIC = CreateObject("Scripting.Dictionary")

For Index = 1 To UBound(arrData)
If Not DIC.Exists(arrData(Index, 1)) Then
DIC.Add arrData(Index, 1), arrData(Index, 3)
Else
DIC.Item(arrData(Index, 1)) = DIC.Item(arrData(Index, 1)) And arrData(Index, 3)
End If
Next

Keys = DIC.Keys
Items = DIC.Items

For n = 0 To UBound(Keys)
If Items(n) Then
Me.ListBox1.AddItem Format(Keys(n), "000")
Else
Me.ListBox2.AddItem Format(Keys(n), "000")
End If
Next

End If
End With
End Sub


Private Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange.Cells(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function


Hope that helps,

Mark

Olwa
05-19-2017, 02:10 AM
Thanks.

mdmackillop
05-19-2017, 02:26 AM
Do both solutions work?

Olwa
05-19-2017, 05:39 AM
"I" as in "my boss" changed "my" mind. Going down another, more complex route. :dunno