I am trying to write selected values in a listbox inside a collection.
I get an error in this line - SelectedEnt.Add ItemReq, Key
Here is my complete code,
Sub YesFormDataSubmit()
Dim SelectedEnt As Collection
Dim Key As Variant
Set SelectedEnt = New Collection
Key = 0
For lItem = 0 To Sheets("Main").Ent_ListBox.ListCount - 1
If Sheets("Main").Ent_ListBox.Selected(lItem) = True Then
ItemReq = Sheets("Main").Ent_ListBox.List(lItem)
If ItemReq <> "" Then
Key= Key + 1
SelectedEnt.Add ItemReq, Key
End If
End If
Next
End Sub
The key is not the index of a collection, consider:
Dim c as New Collection, i as Long
c.Add "David", "999"
c.Add "George", "14"
For i = 1 to c.Count
Debug.Print c(i)
Next
The key must also be a string type, which is why you're getting a mismatch error, passing a long/integer instead of a string.
Unless you are using that key value for something else, you can omit it entirely.You can call them by index without using the key at all.
Just do SelectedEnt.Add ItemReq.
The items will be added to the collection in order, and will be accessible by index e.g., SelectedEnt.Item(1), etc.
If you do need key for some other reason, then you must explicitly cast it to string:
SelectedEnt.Add ItemReq, CStr(Key)
Your error because of that Key must be String.
Sub YesFormDataSubmit()
Dim SelectedEnt As Collection
Dim Key As Variant
Set SelectedEnt = New Collection
Key = 0
For lItem = 0 To Sheets("Main").Ent_ListBox.ListCount - 1
If Sheets("Main").Ent_ListBox.Selected(lItem) = True Then
ItemReq = Sheets("Main").Ent_ListBox.list(lItem)
If ItemReq <> "" Then
Key = Key + 1
'key must be string
SelectedEnt.Add ItemReq, CStr(Key)
End If
End If
Next
End Sub
Related
I'm new to VBA and I got a issue when trying to get item from collection.
I have a self defined class, A, and I have a collection B=[A1,A2...] by using
B.add A
Then I have a dictionary like C={1:B1, 2:B2...} by using
C.add i, Bi
now I want to get the C(i)(j), I build code like following, but it keeps giving me error: object doesn't support this property or method.
dim levels as variant
levels = C.items
dim level as variant
dim newA as A
for i = 0 to levels.count -1
level = levels(i)
for j = 0 to level.count -1
newA = level(j)
next
next
The error happens when I try to assign the collection and class to variant, i.e. level = levels(i) and, newA = level(j)
I know I could use for each to build loop but I need to use the index, and the object it self(might need to modify the object inside the collection later), so wondering what's the best way to do this. Thanks!
Here's an example which works for me.
Class A just has a single field Public id As String
Sub Tester()
Dim C As Object, items, i As Long, objA As A
Set C = CreateObject("scripting.dictionary")
'populate dictionary with a couple of collections of Class A instances
C.Add 1, New Collection
C(1).Add GetAInstance("Id001")
C(1).Add GetAInstance("Id002")
C.Add 2, New Collection
C(2).Add GetAInstance("Id003")
C(2).Add GetAInstance("Id004")
C(2).Add GetAInstance("Id005")
'looping...
items = C.items
For i = LBound(items) To UBound(items)
For Each objA In items(i)
Debug.Print objA.id
Next objA
Next i
'direct access
Debug.Print C(1)(1).id '> "Id001"
Debug.Print C(2)(3).id '> "Id005"
C(2)(3).id = "New id"
Debug.Print C(2)(3).id '> "New id"
Set objA = C(2)(3) 'Set is required for object-type variables
Debug.Print objA.id '> "New id"
End Sub
'function to return an object of class A with supplied id
Function GetAInstance(idValue)
Dim rv As New A
rv.id = idValue
Set GetAInstance = rv
End Function
Already looked in the forum but was not able to find anything similar.
I would like to create a string array where the index “value” is a string.
For instance:
MyArray(“abc”)=1
MyArray(“def”)=2
MyArray(“ghi”)=3
Is there a way to do this in VBA or can I achieve the same in a different way?
A Dictionary Introduction
A Simple Example
Sub DictIntroduction()
Dim InitText As Variant, InitNumbers As Variant
InitText = Array("abc", "def", "ghi")
InitNumbers = Array(1, 2, 3)
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 0 To UBound(InitText)
dict.Add InitText(i), InitNumbers(i)
Next
Dim Key As Variant
For Each Key In dict.Keys
Debug.Print Key, dict(Key)
Next
Debug.Print dict("abc")
Debug.Print dict("def")
Debug.Print dict("ghi")
End Sub
To find out more about the dictionary visit the following links:
Excel VBA Dictionary - A Complete Guide (Article)
Excel VBA Dictionary (YouTube Playlist)
Sub main()
Set myArray = CreateObject("Scripting.Dictionary")
myArray("abc") = 1
myArray("def") = 2
myArray("ghi") = 3
Debug.Print myArray("abc")
For Each tempKey In myArray
Debug.Print tempKey, myArray(tempKey)
Next
End Sub
I'm trying to create a dictionary which has a collection for every key. The reason for this is that I want to retrieve several values from the same key later on. In this example I want to have the total value (val) of a unique key as well as the number of occurrences (n):
sub update()
Dim dict As Dictionary
Dim coll As Collection
Set dict = New Dictionary
Set coll = New Collection
coll.Add 100, "val"
coll.Add 3, "n"
dict.Add "coll", coll
Debug.Print dict.item("coll")("val")
Debug.Print dict.item("coll")("n")
This works fine so far, the problem occurs when I try to update the value in the collection (object doesn't support this):
dict.item("coll")("val") = dict.item("coll")("val") + 100
What I tried:
If I use an array instead of the collection, there is no error but the value doesn't change.
It only works if I read out the collection to variables, change the value, create a new collection, remove the old from the dictionary and add the new collection.
Is there any way to do it like my approach above in a single line?
I would also be happy for an alternative solution to the task.
Once you added an item to the collection, you cannot change it that easily. Such expression:
coll("n") = 5
will cause Run-time error '424': Object required.
You can check it by yourself on the simple example below:
Sub testCol()
Dim col As New VBA.Collection
Call col.Add(1, "a")
col("a") = 2 '<-- this line will cause Run-time error '424'
End Sub
The only way to change the value assigned to the specified key in the given collection is by removing this value and adding another value with the same key.
Below is the simple example how to change the value assigned to a collection with key [a] from 1 to 2:
Sub testCol()
Dim col As New VBA.Collection
With col
Call .Add(1, "a")
Call .Remove("a")
Call .Add(2, "a")
End With
End Sub
Below is your code modified in order to allow you to change the value assigned to the given key in the collection:
Sub update()
Dim dict As Dictionary
Dim coll As Collection
Set dict = New Dictionary
Set coll = New Collection
coll.Add 100, "val"
coll.Add 3, "n"
dict.Add "coll", coll
Debug.Print dict.Item("coll")("val")
Debug.Print dict.Item("coll")("n")
'This works fine so far, the problem occurs when I try to update the value in the collection (object doesn't support this):
Dim newValue As Variant
With dict.Item("coll")
newValue = .Item("val") + 100
On Error Resume Next '<---- [On Error Resume Next] to avoid error if there is no such key in this collection yet.
Call .Remove("val")
On Error GoTo 0
Call .Add(newValue, "val")
End With
End Sub
It is not elegant perhaps, but maybe you can write a sub to update a collection by a key:
Sub UpdateCol(ByRef C As Collection, k As Variant, v As Variant)
On Error Resume Next
C.Remove k
On Error GoTo 0
C.Add v, k
End Sub
Used like this:
Sub Update()
Dim dict As Dictionary
Dim coll As Collection
Set dict = New Dictionary
Set coll = New Collection
coll.Add 100, "val"
coll.Add 3, "n"
dict.Add "coll", coll
Debug.Print dict.Item("coll")("val")
Debug.Print dict.Item("coll")("n")
UpdateCol dict.Item("coll"), "val", dict.Item("coll")("val") + 100
Debug.Print dict.Item("coll")("val")
End Sub
With output as expected:
100
3
200
Here is an approach using a User Defined Object (Class). Hoepfully you can adapt this to your problem.
Rename the Class Module cMyStuff or something else meaningful.
Class Module
Option Explicit
Private pTotalVal As Long
Private pCounter As Long
Public Property Get TotalVal() As Long
TotalVal = pTotalVal
End Property
Public Property Let TotalVal(Value As Long)
pTotalVal = Value
End Property
Public Property Get Counter() As Long
Counter = pCounter
End Property
Public Property Let Counter(Value As Long)
pCounter = Value
End Property
Regular Module
Option Explicit
Sub Update()
Dim cMS As cMyStuff, dMS As Dictionary
Dim I As Long
Set dMS = New Dictionary
For I = 1 To 3
Set cMS = New cMyStuff
With cMS
.Counter = 1
.TotalVal = I * 10
If Not dMS.Exists("coll") Then
dMS.Add "coll", cMS
Else
With dMS("coll")
.TotalVal = .TotalVal + cMS.TotalVal
.Counter = .Counter + 1
End With
End If
End With
Next I
With dMS("coll")
Debug.Print "Total Value", .TotalVal
Debug.Print "Counter", .Counter
End With
End Sub
Results in Immediate Window
Total Value 60
Counter 3
I have an Excel VBA project that makes heavy use of Windows Scripting Dictionary objects. I recently had a user attempt to use it on a Mac and received the following error:
Compile Error: Can't find project or library
Which is the result of using the Tools > References > Microsoft Scripting Runtime library.
My question is, is there a way to make this work on a Mac?
The following are the 3 cases I can think of as being possible solutions:
Use a Mac plugin that enables use of Dictionaries on Macs (my favorite option if one exists)
Do some kind of variable switch like the following:
isMac = CheckIfMac
If isMac Then
' Change dictionary variable to some other data type that is Mac friendly and provides the same functionality
End If
Write 2 completely separate routines to do the same thing (please let this not be what needs to happen):
isMac = CheckIfMac
If isMac Then
DoTheMacRoutine
Else
DoTheWindowsRoutine
End If
Pulling the Answer from the comments to prevent link rot.
Patrick O'Beirne # sysmod wrote a class set that addresses this issue.
Be sure to stop by Patirk's Blog to say thanks! Also there is a chance he has a newer version.
save this as a plain text file named KeyValuePair.cls and import into Excel
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "KeyValuePair"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Unrestricted class just to hold pairs of values together and permit Dictionary object updating
Public Key As String
Public value As Variant
save this as a plain text file named Dictionary.cls and import into excel
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Dictionary"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Collection methods: Add, Count, Item, Remove
'Dictionary : .Add(Key as string, Item as variant), .CompareMode, .Count, .Exists(Key); _
.Item(Key) - writeable, .Items, .Keys, .Remove(Key), .RemoveAll
'plus KeyValuePairs collection, KeyValuePair(Index as long), Tag as variant
' 25-11-2011 KeyValuePair helper object
Public KeyValuePairs As Collection ' open access but allows iteration
Public Tag As Variant ' read/write unrestricted
Private Sub Class_Initialize()
Set KeyValuePairs = New Collection
End Sub
Private Sub Class_Terminate()
Set KeyValuePairs = Nothing
End Sub
' in Scripting.Dictionary this is writeable, here we have only vbtextCompare because we are using a Collection
Public Property Get CompareMode() As VbCompareMethod
CompareMode = vbTextCompare '=1; vbBinaryCompare=0
End Property
Public Property Let Item(Key As String, Item As Variant) ' dic.Item(Key) = value ' update a scalar value for an existing key
Let KeyValuePairs.Item(Key).value = Item
End Property
Public Property Set Item(Key As String, Item As Variant) ' Set dic.Item(Key) = value ' update an object value for an existing key
Set KeyValuePairs.Item(Key).value = Item
End Property
Public Property Get Item(Key As String) As Variant
AssignVariable Item, KeyValuePairs.Item(Key).value
End Property
' Collection parameter order is Add(Item,Key); Dictionary is Add(Key,Item) so always used named arguments
Public Sub Add(Key As String, Item As Variant)
Dim oKVP As KeyValuePair
Set oKVP = New KeyValuePair
oKVP.Key = Key
If IsObject(Item) Then
Set oKVP.value = Item
Else
Let oKVP.value = Item
End If
KeyValuePairs.Add Item:=oKVP, Key:=Key
End Sub
Public Property Get Exists(Key As String) As Boolean
On Error Resume Next
Exists = TypeName(KeyValuePairs.Item(Key)) > "" ' we can have blank key, empty item
End Property
Public Sub Remove(Key As String)
'show error if not there rather than On Error Resume Next
KeyValuePairs.Remove Key
End Sub
Public Sub RemoveAll()
Set KeyValuePairs = Nothing
Set KeyValuePairs = New Collection
End Sub
Public Property Get Count() As Long
Count = KeyValuePairs.Count
End Property
Public Property Get Items() As Variant ' for compatibility with Scripting.Dictionary
Dim vlist As Variant, i As Long
If Me.Count > 0 Then
ReDim vlist(0 To Me.Count - 1) ' to get a 0-based array same as scripting.dictionary
For i = LBound(vlist) To UBound(vlist)
AssignVariable vlist(i), KeyValuePairs.Item(1 + i).value ' could be scalar or array or object
Next i
Items = vlist
End If
End Property
Public Property Get Keys() As String()
Dim vlist() As String, i As Long
If Me.Count > 0 Then
ReDim vlist(0 To Me.Count - 1)
For i = LBound(vlist) To UBound(vlist)
vlist(i) = KeyValuePairs.Item(1 + i).Key '
Next i
Keys = vlist
End If
End Property
Public Property Get KeyValuePair(Index As Long) As Variant ' returns KeyValuePair object
Set KeyValuePair = KeyValuePairs.Item(1 + Index) ' collections are 1-based
End Property
Private Sub AssignVariable(variable As Variant, value As Variant)
If IsObject(value) Then
Set variable = value
Else
Let variable = value
End If
End Sub
Public Sub DebugPrint()
Dim lItem As Long, lIndex As Long, vItem As Variant, oKVP As KeyValuePair
lItem = 0
For Each oKVP In KeyValuePairs
lItem = lItem + 1
Debug.Print lItem; oKVP.Key; " "; TypeName(oKVP.value);
If InStr(1, TypeName(oKVP.value), "()") > 0 Then
vItem = oKVP.value
Debug.Print "("; CStr(LBound(vItem)); " to "; CStr(UBound(vItem)); ")";
For lIndex = LBound(vItem) To UBound(vItem)
Debug.Print " (" & CStr(lIndex) & ")"; TypeName(vItem(lIndex)); "="; vItem(lIndex);
Next
Debug.Print
Else
Debug.Print "="; oKVP.value
End If
Next
End Sub
'NB VBA Collection object index is 1-based, scripting.dictionary items array is 0-based
'cf Scripting.Dictionary Methods s.Add(Key, Item), s.CompareMode, s.Count, s.Exists(Key); _
s.Item(Key) - updateable, s.Items, s.Key(Key), s.Keys, s.Remove(Key), s.RemoveAll
'Scripting.Dictionary has no index number; you can index the 0-based variant array of Items returned
' unlike Collections which can be indexed starting at 1
'Efficient iteration is For Each varPair in thisdic.KeyValuePairs
'Another difference I introduce is that in a scripting.dictionary, the doc says
' If key is not found when changing an item, a new key is created with the specified newitem.
' If key is not found when attempting to return an existing item, a new key is created and its corresponding item is left empty.
'but I want to raise an error when addressing a key that does not exist
'similarly, the scripting.dictionary will create separate integer and string keys for eg 2
Patirk's implementation doesn't work for MS Office 2016 on Mac. I made use of the implementation by Tim Hall.
Here is the link: https://github.com/VBA-tools/VBA-Dictionary
Also import of cls files into Excel doesn't work in MS Office 2016 on Mac as of September 2017. So I had to create a class module and to copy and paste the contents of Dictionary.cls manually in that module while removing meta info from Dictionary.cls such as VERSION 1.0 CLASS, BEGIN, END, Attribute.
I have at last updated the files for Excel 2016 for Mac.
http://www.sysmod.com/Dictionary.zip
(capital D in Dictionary)
Unzip this and import the class files (tested in Excel 2016 for Mac 16.13 Build 424, 27-Apr-2018)
My bug report to MS is at answers.microsoft.com
Excel 16.13 for Mac User Defined Class passed as parameter all properties are Null
Let me know if I've missed anything else!
Good luck,
Patrick O'Beirne
How do i write a function in excel vba that is something like this in php?
public function name($data) {
if ($data==="*") {
return "*";
}
if (isset($data[0])) {
return $data[0];
}
}
The biggest issue is that i need to define the data type in the function for my parameter
I am expecting either a string or a dictionary that has a key called "0"
A 0 in dictionary doesn't hold any value. A 1 perhaps can give you the desired result. I don't know php but whatever I could understand from the above code and your requirement, this is what I came up with so I am not sure if this is what you want?
Sub Sample()
Dim Dict1 As Dictionary
Dim sString As String
Set Dict1 = New Dictionary
With Dict1
.CompareMode = BinaryCompare
.Add 1, "Item 1"
End With
sString = "Sid"
Debug.Print sName(Dict1)
Debug.Print sName(sString)
End Sub
Public Function sName(Inpt As Variant) As Variant
If TypeName(Inpt) = "Dictionary" Then
sName = Inpt.Item(1)
ElseIf TypeName(Inpt) = "String" Then
sName = Inpt
End If
End Function
EDIT
If you still want to use 0, then while adding to the dictionary, use a 0 for example
With Dict1
.CompareMode = BinaryCompare
.Add 0, "Item 1"
End With
and then you can use a 0 in the function as below
sName = Inpt.Item(0)
SNAPSHOT (ALL 3 CONDITIONS - USE OF 0 AND 1)
HTH
Sid