malik641
12-10-2005, 10:01 AM
Referring to this thread (http://www.vbaexpress.com/forum/showthread.php?t=4186&highlight=unique+listbox), most notably Bob's first post. What did you (Bob) mean by loading with All item????
I'm trying to do what Malcom did (load a list box with unique entries in a given range)...but he never posted his finished code :mkay So I'm kinda lost...Especially because I've never used the Scripting.Dictionary object.
Here's the code (Not near complete, I'm just testing the loading of one list box):
Option Explicit
Private Sub Userform_Initialize()
On Error Resume Next
AddGUID
Dim cell As Variant
Dim SponsorList As New Scripting.Dictionary
Dim StudyNumList As New Scripting.Dictionary
Dim ValidationList As New Scripting.Dictionary
Dim ProjectList As New Scripting.Dictionary
Dim SponsorRange As Range
Dim StudyNumRange As Range
Dim CriteriaRange As Range
Dim ValidationRange As Range
Dim ProjectRange As Range
Dim i As Long
i = 0
With Workbooks("Bioanalytical MS.xls").Sheets("Forecast")
'Criteria Headings that require Text (set range to get unique entries)
Set SponsorRange = .Range("A7:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
Set StudyNumRange = .Range("B7:B" & .Cells(Rows.Count, "B").End(xlUp).Row)
Set ValidationRange = .Range("C7:C" & .Cells(Rows.Count, "C").End(xlUp).Row)
Set ProjectRange = .Range("E7:E" & .Cells(Rows.Count, "E").End(xlUp).Row)
'Criteria Headings that require dates (Range contains items to fill lstCriteria)
Set CriteriaRange = .Range("D6, G6:R6")
End With
For Each cell In SponsorRange
i = i + 1
SponsorList.Add i, cell.Text
Next
For Each cell In SponsorList
If SponsorList.Item(cell) = vbNullString Then Exit For
lstSponsor.AddItem SponsorList.Item(cell)
Next cell
End Sub
Private Sub AddGUID()
'Adds the Script Control to the workbook
On Error Resume Next
Dim strGUID As String
strGUID = "{420B2830-E718-11CF-893D-00A0C9054228}"
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUID, Major:=1, Minor:=0
End Sub
But when the userform loads...I still get duplicate entries :dunno what's the matter?
I'm trying to do what Malcom did (load a list box with unique entries in a given range)...but he never posted his finished code :mkay So I'm kinda lost...Especially because I've never used the Scripting.Dictionary object.
Here's the code (Not near complete, I'm just testing the loading of one list box):
Option Explicit
Private Sub Userform_Initialize()
On Error Resume Next
AddGUID
Dim cell As Variant
Dim SponsorList As New Scripting.Dictionary
Dim StudyNumList As New Scripting.Dictionary
Dim ValidationList As New Scripting.Dictionary
Dim ProjectList As New Scripting.Dictionary
Dim SponsorRange As Range
Dim StudyNumRange As Range
Dim CriteriaRange As Range
Dim ValidationRange As Range
Dim ProjectRange As Range
Dim i As Long
i = 0
With Workbooks("Bioanalytical MS.xls").Sheets("Forecast")
'Criteria Headings that require Text (set range to get unique entries)
Set SponsorRange = .Range("A7:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
Set StudyNumRange = .Range("B7:B" & .Cells(Rows.Count, "B").End(xlUp).Row)
Set ValidationRange = .Range("C7:C" & .Cells(Rows.Count, "C").End(xlUp).Row)
Set ProjectRange = .Range("E7:E" & .Cells(Rows.Count, "E").End(xlUp).Row)
'Criteria Headings that require dates (Range contains items to fill lstCriteria)
Set CriteriaRange = .Range("D6, G6:R6")
End With
For Each cell In SponsorRange
i = i + 1
SponsorList.Add i, cell.Text
Next
For Each cell In SponsorList
If SponsorList.Item(cell) = vbNullString Then Exit For
lstSponsor.AddItem SponsorList.Item(cell)
Next cell
End Sub
Private Sub AddGUID()
'Adds the Script Control to the workbook
On Error Resume Next
Dim strGUID As String
strGUID = "{420B2830-E718-11CF-893D-00A0C9054228}"
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUID, Major:=1, Minor:=0
End Sub
But when the userform loads...I still get duplicate entries :dunno what's the matter?