Solved: Scripting.Dictionary question

[malik641]

Referring to this thread, 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 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):
[VBA] 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
[/VBA]
But when the userform loads...I still get duplicate entries what's the matter?

[mdmackillop]

Hi Joseph,
I used the code here http://vbaexpress.com/forum/showthread.php?t=6054 in the sub SetList. I'll have a look at your code.

[mdmackillop]

I'm not an expert with Dictionary objects and use it without full understanding, but try
[VBA]
For Each cell In SponsorRange
cell.Interior.ColorIndex = 8
SponsorList.Add cell.Text, cell.Text
Next
a = SponsorList.Items
For i = 0 To SponsorList.Count - 1
lstSponsor.AddItem a(i)
Next
[/VBA]

[Bob Phillips]

Referring to this thread, most notably Bob's first post. What did you (Bob) mean by loading with All item????

In this example, we were discussing using it as a filter. So, as well as loading each of the data items, I suggested loading a pseudo-data item of 'All', so that an unfiltered list could be provided.

[malik641]

In this example, we were discussing using it as a filter. So, as well as loading each of the data items, I suggested loading a pseudo-data item of 'All', so that an unfiltered list could be provided.

Yeah I kinda figured that when I checked out Malcom's thread he gave me in his first reply. Thanks Bob.


Malcom,
Funny, I came up with something very similar to that:
[VBA]'Sponsor Criteria
For Each cell In SponsorRange
On Error Resume Next
SponsorList.Add cell.Text, cell.Text
Next
ScriptDict = SponsorList.Items
For i = 0 To SponsorList.Count - 1 Step 1
lstSponsor.AddItem ScriptDict(i)
Next i[/VBA]

Thanks again You're on a role today Malcom

[mdmackillop]

Hi Joseph,
I was working with Dictionaries/Comboboxes the other day (http://www.vbaexpress.com/forum/showthread.php?t=7533), so a little bit more learning.
Regards
MD

[vba]
'Sponsor Criteria
For Each Cell In SponsorRange
On Error Resume Next
SponsorList.Add Cell.Text, Cell.Text
Next
lstSponsor.List() = SponsorList.Items

[/vba]

[malik641]

Nice, thanks Malcom Makes like that much easier.


I bet that code performs much faster too, huh?

[jindon]

Hi

(load a list box with unique entries in a given range

if you need to compare Text compre then you need to add
Sponsorlist.comparemode=vbtextcompare
and you don't need to create many dictionary object unless you use them at a time

Sponsorlist.removeall

will initialize the dictionary object...
[vba]
For Each cell In SponsorRange
if not isempty(cell) then
if not sponsorlist.exists(cell.value) then
SponsorList.Add cell.value, nothing
end if
end if
Next
lstSponsor.List() = SponsorList.Keys
[/vba]

[jindon]

MD,

Regarding your PM,

Dictionary object has four properties which are
1) Keys
2) Items
3) Count
4) Comparemode

mostly 1) & 2) are the factors
Key property can only hold UNQUE value and Item is its corresponding descreption, so to say, like Dictionary
and the beauty of it is that we can re-write items anytime.
e.g.
set dic=createobject("scripting.dictionary")
dic.add "Tom", 25
dic.add "Bill", 35
dic.add "Jim", 45

now you can retrieve info like
x=dic.item("Tom") (= 25) (dic("Tom") is the same)
and you can also change its item like
dic("Tom")=20
then
x=dic("Tom") (=20)

then
dic.Keys hold all the key elements and items for dic.Items

What I'm always using this object for is to hold few different infomation for each key like
redim w(1)
w(0)=25 (age)
w(1)="m" (sex)
dic.add "Tom", w

then you can retrieve Tom's age like
msgbox dic("Tom")(0) & " : " & dic("Tom")(1)

This is much easier than making custom property and type.etc...

I think the dictionary object is really powerful and fast, especially when you
use it with array.

rgds,
jindon

[mdmackillop]

Thanks Jindon