View Full Version : [SOLVED:] Filling two listboxes
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
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
mdmackillop
05-19-2017, 02:26 AM
Do both solutions work?
"I" as in "my boss" changed "my" mind. Going down another, more complex route. :dunno
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.