I'm trying to establish a public dictionary to query at various points in the use of my document. But- the document appears to "forget" about the dictionary assigned? Is there a problem with my code?
Dim hedDict As Scripting.Dictionary
Public Function headDict()
On Error Resume Next
Dim i As Long
Dim z As Long
Dim x As Variant
Dim c As Variant
Dim d As Variant
Set hedDict = New Dictionary
z = Range("A1").End(xlToRight).Column
Sheets("New Item Entry").Select
Range("A2").Select
i = 1
Do While i <= z
c = Columns(i).Rows(1).Value
d = i
Call addToDict(hedDict, c, d)
i = i + 1
Loop
End Function
Function addToDict(dic, iteem, val)
dic.Add iteem, val
End Function
Sub ChckTst()
Dim x as Long
x = Cells(i, hedDict("Order UOM Price")).Value
MsgBox (x)
End Sub
The subroutine above does various other things before calling on the dictionary, such as calling a plethora of variables, assigning an array, and creating a collection. If that could interfere, please let me know.
Thank you
Related
I try to fill an array with objects that are created within a loop as follows. The problem is that all cells seem to have the same object in the end. The explanation might be that obj is not a local variable with respect to the loop.
Sub foo()
Dim Arr(1 To 3) As Class1
Dim i As Integer
For i = 1 To 3
Dim obj As New Class1
obj.name = i
Set Arr(i) = obj
Next
For i = 1 To 3
Debug.Print Arr(i).name
Next
End Sub
Surprisingly, the output is
3
3
3
I have also tried to remove the Set and instead have Arr(i) = obj. That results in Object variable or with block variable not set.
Your issue is the declaration of your object.
Dim foo as New bar
That is called a self-assigned declaration what makes setting a new object optional. If you call an objects member and it is not allready set it get's created (implicitSet foo = New bar). But as you allready created an instance (on first call toobj.name). that one is reused and the same reference is stored three times for the same objects-instance. That's why all elements in array return the same value as they are the same objects-instance, not three different ones.
So don't useNewin declarations, then you always need aSet fooand can check the object instance onNothing.
A second issue with your code is that assigninig an object to an array is that deleting elements from an array is error prone and not deleted references lead to not disposed, but unused objects.
The prefered storage for object(-references) is aCollection.
Sub foo()
Dim ObjCollection as Collection
Set ObjCollection = New Collection
Dim i As Integer
For i = 1 To 3
Dim obj As bar
Set obj = New bar
obj.name = i
ObjCollection.Add obj
Next
For i = 1 To 3
Debug.Print ObjCollection(i).name
Next
End Sub
This is the way:-
Sub foo()
Dim Arr(1 To 3) As Variant
Dim i As Integer
For i = 1 To 3
Set Arr(i) = Worksheets(i)
Next
For i = 1 To 3
Debug.Print Arr(i).Name
Next
End Sub
You have 2 ways to do this:
Notes: obj has not been recreated, so when you call for the next time obj in Arr (1) is still affected by the subsequent call.
First:
Sub foo()
Dim Arr(2) As Variant
Dim i As Integer
Dim obj As New Class1
For i = 0 To 2
Set obj = New Class1 '<<<-----
obj.name = i
Set Arr(i) = obj
Next
For i = 0 To 2
Debug.Print Arr(i).name
Next
End Sub
Second:
Sub foo()
Dim Arr(2) As Variant
Dim i As Integer
For i = 0 To 2
Dim obj As New Class1
obj.name = i
Set Arr(i) = obj
Set obj = Nothing <<<-----
Next
For i = 0 To 2
Debug.Print Arr(i).name
Next
End Sub
Try this, it'll save you a lot of headaches. Cheers!
Option Explicit
Sub foo()
Dim Arr(1 To 3) As New Class1 ' < good to know this version
Dim i As Long
For i = 1 To 3
With Arr(i) ' < saves you some typing
.Name = i
Debug.Print .Name
End With
Next
End Sub
Greetings I have the following code:
Private Sub makeNewReports()
Dim wkSheet As Worksheet
Set wkSheet = ActiveWorkbook.Worksheets("Grades")
Dim i As Long
Dim myMap As Dictionary
Set myMap = New Dictionary
For i = 4 To 6 'wkSheet.Range("a1").End(xlToRight).Column - 1
Dim myVals As dateValueItem
myVals.total_value = wkSheet.Cells(2, i)
myVals.items = wkSheet.Cells(1, i)
myVals.student_value = wkSheet.Cells(4, i)
myMap.Add wkSheet.Cells(3, i), myVals
Next i
End Sub
and the following code for dateValueItem
Option Explicit
Public Type dateValueItem
total_value As Long
items As String
student_value As Long
End Type
when I run the above code I get the problem
'Compile Error: Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late bound functions'
I'm trying to map together 3 different values to a specific date; the dates are held in row three. Row 2 and 4 has numerical values, and row 1 has string values. The hope is to be able to organize all of these together so I can eventually connect descriptions and values to dates.
This might be the quickest way. Create a class and name it dateValueItem
Option Explicit
Public total_value As Long
Public items As String
Public student_value As Long
And change your code to
Option Explicit
Private Sub makeNewReports()
Dim wkSheet As Worksheet
Set wkSheet = ActiveWorkbook.Worksheets("Grades")
Dim i As Long
Dim myMap As Dictionary
Set myMap = New Dictionary
Dim myVals As dateValueItem
For i = 4 To 6 'wkSheet.Range("a1").End(xlToRight).Column - 1
Set myVals = New dateValueItem
myVals.total_value = wkSheet.Cells(2, i)
myVals.items = wkSheet.Cells(1, i)
myVals.student_value = wkSheet.Cells(4, i)
myMap.Add wkSheet.Cells(3, i), myVals
Next i
End Sub
I have typed the following code in Excel VBA:
The function should create a dictionary acording to unique values in a certain column part.
Function CreateDictForFactors(xcord As Integer, ycord As Integer, length As Integer) As Dictionary
Dim Dict As Dictionary
Set Dict = New Dictionary
Dim i As Integer
For i = 0 To length - 1
If Not Dict.Exists(Cells(xcord + i, ycord)) Then
Dict.Add Cells(xcord + i, ycord), 0
End If
Next i
Set CreateDictForFactors = Dict
End Function
Sub test2()
Dim dict1 As Dictionary
Set dict1 = CreateDictForFactors(7, 6, 12)
End Sub
I found this code as an excample for dictionaries and functions:
Sub mySub()
dim myDict as Dictionary
set myDict = myFunc()
End Sub
Function myFunc() as Dictionary
dim myDict2 as Dictionary
set myDict2 = new Dictionary
'some code that does things and adds to myDict2'
set myFunc=myDict2
End Function
However when I try to run the makro test2 it gives the error message:
User-defined type not defined
Can anyone tell where I made a mistake?
Thank you in advance
G'day,
Did you add "Microsoft Scripting Runtime" as a reference to your project?
Once you've done that, declare dict as a Scripting.Dictionary like this:
Dim dict As Scripting.Dictionary
You can create the object as follows:
Set dict = New Scripting.Dictionary
This is a good website describing the use of a dictionary:
https://excelmacromastery.com/vba-dictionary/
Hope this helps.
You can also late bind the code like this:
Function CreateDictForFactors(xcord As Integer, ycord As Integer, length As Integer) As Dictionary
Dim Dict As Object
Set Dict = CreateObject("Scripting.Dictionary")
Dim i As Integer
For i = 0 To length - 1
If Not Dict.Exists(Cells(xcord + i, ycord)) Then
Dict.Add Cells(xcord + i, ycord), 0
End If
Next i
Set CreateDictForFactors = Dict
End Function
Sub test2()
Dim dict1 As Object
Set dict1 = CreateDictForFactors(7, 6, 12)
End Sub
Note that neither method will work on a Mac.
How do I do this? Here's some sample code I tried
Sub testing()
Dim n As Long
Dim dict As New Dictionary
Dim obj as MyClass
For n = 1 To 10
Set obj = New MyClass
obj.value="I am an object" 'setting obj property
dict.Add n, bcell
Next n
subDict.Add dict.Keys(1), dict.Items(1)'error here
End Sub
This throws an error:
'Run-time error 424:
Object required
Both the Item and the Key are required - that's why you were getting the 'argument not optional' error.
Now you're adding bcell which is neither declared nor instantiated. Did you mean to add obj?
Sub test()
Dim Dict As Scripting.Dictionary
Dim subDict As Scripting.Dictionary
Dim obj As MyClass
Dim n As Long
Set Dict = New Scripting.Dictionary
For n = 1 To 10
Set obj = New MyClass
obj.Value = "I'm object #" & n
Dict.Add n, obj
Next n
Set subDict = New Scripting.Dictionary
subDict.Add Dict.Keys(0), Dict.Items(0)
Debug.Print subDict.Items(0).Value
End Sub
Note that dictionairy indeces start at 0 and not 1.
is there a proper way to count elements of an enum in VBA ?
At the moment, I leave an enum value such as KeepThisOneHere in the following example
Enum TestEnum
ValueA
ValueB
ValueC
KeepThisOneHere
End Enum
I use the last value to know the size... I don't like this solution, because I am not sure I have a guarantee the values will always be indexed the same way, and the code might be changed by a third party who might add values after this last special one, silently breaking the rest of the code.
Not sure on the etiquette here, so I'll post it and if advised, I'll come back and delete it. Chip Pearson posted this code on the Code Cage Forums (http://www.thecodecage.com/forumz/microsoft-excel-forum/170961-loop-enumeration-constants.html). I don't have the TypeLinInfo DLL on my machine, so I can't test it (I'm sure google will turn up places to download TLBINF32.dll). Nonetheless, here is his entire post to save someone else from registering for a forum:
You can do this ONLY IF you have the TypeLibInfo DLL installed on your
computer. In VBA, go to the Tools menu, choose References, and scroll
down to "TypeLib Info". If this item exists, check it. If it does not
exist, then quit reading because you can't do what you want to do. The
file name of the DLL you need is TLBINF32.dll.
The following code shows how to get the names and values in the
XLYesNoGuess enum:
Sub AAA()
Dim TLIApp As TLI.TLIApplication
Dim TLILibInfo As TLI.TypeLibInfo
Dim MemInfo As TLI.MemberInfo
Dim N As Long
Dim S As String
Dim ConstName As String
Set TLIApp = New TLI.TLIApplication
Set TLILibInfo = New TLI.TypeLibInfo
Set TLILibInfo = TLIApp.TypeLibInfoFromFile( _
ThisWorkbook.VBProject.References("EXCEL").FullPath)
ConstName = "XLYesNoGuess"
For Each MemInfo In _
TLILibInfo.Constants.NamedItem(ConstName).Members
S = MemInfo.Name
N = MemInfo.Value
Debug.Print S, CStr(N)
Next MemInfo
End Sub
Using this knowledge, you can create two useful functions. EnumNames
returns an array of strings containing the names of the values in an
enum:
Function EnumNames(EnumGroupName As String) As String()
Dim TLIApp As TLI.TLIApplication
Dim TLILibInfo As TLI.TypeLibInfo
Dim MemInfo As TLI.MemberInfo
Dim Arr() As String
Dim Ndx As Long
Set TLIApp = New TLI.TLIApplication
Set TLILibInfo = New TLI.TypeLibInfo
Set TLILibInfo = TLIApp.TypeLibInfoFromFile( _
ThisWorkbook.VBProject.References("EXCEL").FullPath)
On Error Resume Next
With TLILibInfo.Constants.NamedItem(EnumGroupName)
ReDim Arr(1 To .Members.Count)
For Each MemInfo In .Members
Ndx = Ndx + 1
Arr(Ndx) = MemInfo.Name
Next MemInfo
End With
EnumNames = Arr
End Function
You would call this function with code such as:
Sub ZZZ()
Dim Arr() As String
Dim N As Long
Arr = EnumNames("XLYesNoGuess")
For N = LBound(Arr) To UBound(Arr)
Debug.Print Arr(N)
Next N
End Sub
You can also create a function to test if a value is defined for an
enum:
Function IsValidValue(EnumGroupName As String, Value As Long) As
Boolean
Dim TLIApp As TLI.TLIApplication
Dim TLILibInfo As TLI.TypeLibInfo
Dim MemInfo As TLI.MemberInfo
Dim Ndx As Long
Set TLIApp = New TLI.TLIApplication
Set TLILibInfo = New TLI.TypeLibInfo
Set TLILibInfo = TLIApp.TypeLibInfoFromFile( _
ThisWorkbook.VBProject.References("EXCEL").FullPath)
On Error Resume Next
With TLILibInfo.Constants.NamedItem(EnumGroupName)
For Ndx = 1 To .Members.Count
If .Members(Ndx).Value = Value Then
IsValidValue = True
Exit Function
End If
Next Ndx
End With
IsValidValue = False
End Function
This function returns True if Value is defined for EnumGroupName or
False if it is not defined. You would call this function with code
like the following:
Sub ABC()
Dim B As Boolean
B = IsValidValue("XLYesNoGuess", xlYes)
Debug.Print B ' True for xlYes
B = IsValidValue("XLYesNoGuess", 12345)
Debug.Print B ' False for 12345
End Sub
Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]
Here's an example of my workaround, which is pretty straightforward:
Enum FileSpecFields
FileSpecFields_Start '(zero-based)
FileNameIdx = FileSpecFields_Start
FolderNameIdx
BasePathIdx
FullPathIdx
CopyStatus
FileSpecFields_End = CopyStatus
End Enum
'...
ReDim FileSpecList(1 To MaxFiles, FileSpecFields_Start To FileSpecFields_End) As String
'...
But note that, if you are using a one-based Enum you may have to adjust the _End value definition, depending on how you're using it. Also, for zero-based Enums, the _End value is not the same as its count of items. And, if you add items at the end, you must update the _End value's definition accordingly. Finally, if your enum is a non-contiguous range of values, all bets are off with this approach!
there isn't a way to get the count.
What you have to do is loop through the elements of the Enum until you get to the last one.
Chip Pearson has some good tips on Enumerated constants: Chip Pearson: Enum Variable Type
If you know the enum type(s) on design-time you could transform them into a Static Property Get MyEnumColl() as Collection ... (no class needed, initialized on 1st access statically) and thus easily loop through them or count them like shown here
Sub count()
Dim n, c
For n = headers.frstItem To headers.lastItem
c = c + 1
Next
Debug.Print c
End Sub