After creating a new dictionary:
Dim teams as Dictionary
Set teams = New Dictionary
I noticed that it already contains empty key - value pair (teams.Count returns value of 1).
How can I prevent this from happening or delete this pair? Is this normal behaviour?
I had the same experience and solved it.
I had a Watch expression set for a value in the dictionary. Somehow this kept the empty key/value pair in the dictionary (or kept readding it).
Removing the watch(es) and stepping through the code I now see the dictionary does not have the Empty/Empty item any longer.
If you are referencing the same Microsoft Scripting Runtime dictionary scrrun.dll as me - Excel 2010.
Then the below code returns 0 as the .Count of items after creation with no manipulation.
Sub SD()
Dim teams As Dictionary
Set teams = New Dictionary
Debug.Print teams.Count
End Sub
I wouldn't know the reason why your dictionary returns 1, however I think a workaround it would be to simply use the .RemoveAll method of the Dictionary object
Sub SD()
Dim teams As Dictionary
Set teams = New Dictionary
teams.RemoveAll
Debug.Print teams.Count
End Sub
Related
I have the below code to populate a listbox, therefore I want to remove duplicates from my combobox. I Don't know how to do it:
Private Sub CommandButton1_Click()
Dim ws_suivi As Worksheet
Set ws_suivi = ActiveWorkbook.Worksheets("suivi")
Fin_Liste_suivi = ws_suivi.Range("A65530").End(xlUp).Row
For i = 2 To Fin_Liste_suivi
UserForm_SDE.ComboBox_Type_Rapp.AddItem ws_suivi.Range("AD" & i)
Next
UserForm_SDE.Show
End Sub
It is often worth searching to see if a Library for VBA exists that will save you reinventing the wheel.
It is a particular annoyance of VBA that whilst we have such useful structures as Collections and Scripting.Dictionaries there is no easy way to get information into such objects or to do much processing of the data once those objects are populated.
I had a project which had a lot of processing of arrays/scripting.dictionariews and to make my life a little easier I created a VBA library in C# called Kvp (for Key Value Pairs) which is a bit like a Scripting.Dictionary on steriods.
You can download the library, source code, documentation for the Kvp object from here
Once you have added a reference to the Kvp library you can declare a Kvp object in the standard way.
Dim myKvp as Kvp
Set myKvp=New Kvp
You can then add a 1D range from an excel spreadsheet in a single statement
myKvp.AddByIndexFromArray <excel range>.Value
which gives a Kvp of long integers vs cell values
The OP wishes a list of unique values. To do this with a Kvp we can use the Mirror method to create a Kvp of the unique values.
Dim myMirroredKvp as Kvp
set myMirroredKvp=myKvp.Mirror
The Mirror method returns a Two item Kvp where item 0 is a Kvp of unique items vs the first Key at which the item was found and item 1 is a Kvp of original Keys vs value where the values are a duplicate.
You can then get an array of the keys using the GetKeys method
Dim myUniqueValues as Variant
myUniqueValues = myMirroredKvp.GetItem(0).GetKeys
Or should you want the items sorted in reverse order
myUniqueValues - myMirroredKvp.GetItem(0).GetKeysDescending
The above can be shortened to
myUniqueValues = myKvp.Mirror.GetItem(0).GetKeysDescending
I've found the Kvp library quite useful. I hope you do to!!
While you could load the list to a Dictionary, you might find it simpler to try using WorksheetFunction.CountIf to check if the item is further up your list (and has, thus, already been included):
If (i=2) OR (WorksheetFunction.CountIf(ws_suivi.Range(ws_suivi.Cells(2,30),ws_suivi.Cells(i-1,30)), ws_suivi.cells(i,30).Value)<1) Then
UserForm_SDE.ComboBox_Type_Rapp.AddItem ws_suivi.Range("AD" & i)
End If
As a side-note: Since Excel 2007 increased the Row Limit from 65536 (216) to 1048576 (220), you may want to change Fin_Liste_suivi = ws_suivi.Range("A65530").End(xlUp).Row to Fin_Liste_suivi = ws_suivi.Cells(ws_suivi.Rows.Count, 1).End(xlUp).Row
I found :
Dim Valeur As String
Dim i As Integer
Dim j As Integer
'For each element in the list
For i = 0 To lst_ref.ListCount - 1
Valeur = Combobox.List(i)
For j = i + 1 To Combobox.ListCount - 1
'If the element exist, delete it
If Valeur = Combobox.List(j) Then
Call Combobox.RemoveItem(j)
End If
Next j
Next i
It take the beggining of the combobox and check if the value is red again in to the end of the combobox.
I'm working in Excel with VBA to collect data for a table I'm building I have to go out to a TN3270 emulator to get it. In order to work with with the emulator I have to define a few objects to do the work. I also have a few helper functions that are used by multiple functions to navigate to different screens in the emulator. So far in order to use them I have had to copy the object definitions into those functions to get them to work. This works most of the time but occasionally (and in a way I cant predictably replicate) I get an error when the helper is recreating a particular object to use.
Option Explicit
Public Sub gather_data()
Dim TN_Emulator As Object
Dim Workbook As Object
Set TN_Emulator = CreateObject("TN_Emulator.Program")
Set Workbook = ActiveWorkbook
Dim string_from_excel As String
#for loop to go through table rows
#put value in string_from_excel
If string_from_excel = some condition
go_to_screen_2
#grab and put data back in excel
Else
go_to_screen_3
#grab and put data back in excel
End If
go_to_screen_1
#next loop logic
End Sub
Public Sub go_to_screen_1()
Dim TN_Emulator As Object
#the next step occasionally throws the error
Set TN_Emulator = CreateObject("TN_Emulator.Program")
#send instructions to the emulator
End Sub
Is there a way to import the existing objects (that get created and used without any errors) without redefining them into the helper functions to avoid this problem? I have tried searching in google but I don't think I'm using the right search terms.
First thanks goes to #JosephC and #Damian for posting the answer for me in the comments.
From JosephC 'The Key words you're looking for are: "How to pass arguments to a function".', and he provided the following link ByRef vs ByVal describing two different ways to pass arguments in the function call.
And from Damian the solution to my immediate concern. Instead of declaring and setting the objects that will be used in body of the helper function. Place the object names and types in the parentheses of the initial helper name, and when calling the helper from the other function also in the parentheses, shown below.
Option Explicit
Public Sub gather_data()
Dim TN_Emulator As Object
Dim Workbook As Object
Set TN_Emulator = CreateObject("TN_Emulator.Program")
Set Workbook = ActiveWorkbook
Dim string_from_excel As String
#for loop to go through table rows
#put value in string_from_excel
If string_from_excel = some condition
Call go_to_screen_2(TN_Emulator)
#grab and put data back in excel
Else
Call go_to_screen_3(TN_Emulator)
#grab and put data back in excel
End If
Call go_to_screen_1(TN_Emulator)
#next loop logic
End Sub
Public Sub go_to_screen_1(TN_Emulator As Object)
#send instructions to the emulator
End Sub
I believe I understood the instructions correctly, and have successfully tested this for my-self. I also passed multiple objects in the helper function definition and calls as needed for my actual application, in the same order each time Ex.
Sub go_to_screen_1(TN_Emulator As Object, ConnectionName As Object)
and
Call go_to_screen_1(TN_Emulator, ConnectionName)
I am not able to create a nested dictionary, assign it to a variable, overwrite one of the inner values, and then assign it to another variable without the original variable's value getting changed, which I do not want. For example, see the following code:
Option Explicit
Sub Button1_Click()
Dim d_outer As Scripting.Dictionary
Set d_outer = New Scripting.Dictionary
Dim d_inner As Scripting.Dictionary
Set d_inner = New Scripting.Dictionary
Call d_inner.Add("key", "foo")
Call d_outer.Add("first attempt", d_inner)
' Cannot use "Add", since key already exists, must use Item()
d_inner.Item("key") = "bar"
Call d_outer.Add("second attempt", d_inner)
' Print all values.
Dim v_outer As Variant
Dim v_inner As Variant
For Each v_outer In d_outer.Keys()
For Each v_inner In d_outer(v_outer).Keys()
Debug.Print "(" & v_outer & ", " & v_inner & "): '" & d_outer(v_outer)(v_inner) & "'"
Next v_inner
Next v_outer
End Sub
This produces the following output:
(first attempt, key): 'bar'
(second attempt, key): 'bar'
The first attempt's value should be foo. Why is it getting changed to bar? How do I fix this? Do I need to create a new dictionary that's an exact copy of d_inner every time I want to change only one of the values? If so, is there an easy way to do that?
In your first collection you have created a reference to an object rather than placing a value in there (for example). So as you change the inner collection it is updated in the initial outer collection.
You need to create a New object to put into the second collection. Like this:
' Cannot use "Add", since key already exists, must use Item()
Set d_inner = New Scripting.Dictionary
Call d_inner.Add("key", "bar")
Gives:
(first attempt, key): 'foo'
(second attempt, key): 'bar'
Depending on what you are trying to achieve here, you might find that classes are more flexible with these kinds of tasks
The problem I have is that the user is copying from one content control and pasting it into another accidentally. When extracting the data from this form, it then picks up that extra CC and therefore the value twice over.
When pulling the data I'm trying to see if a CC has a ParentCC and then delete it, but I keep getting
Run time error 5825: Object has been deleted.
I can understand why but I'm unsure as to how get around it, nothing I've searched seems to work.
'With Word document Statement precedes this
For Each CCtrl In .ContentControls
CCtrlText = CCtrl.Range.Text
If Not CCtrl.ParentContentControl Is Nothing Then
CCtrl.ParentContentControl.Range.Text = CCtrlText
CCtrl.Delete
End If
Next
How can I remove this content control which is duplicated inside the other and retain the input information?
So after some messing around and looking into how the local variables properties changed as a stepped through the code I have found that the line:
CCtrl.ParentContentControl.Range.Text = CCtrlText
Was in effect replacing the Content Control (CC) in it's ParentCC range property with the input text, and therefore deleting the duplicated CC.
CCtrl.Delete was trying to delete an object that had already been deleted and that swhy it was throwing an error.
I think with a foreach loop you can't alter the contents of the list/array without impacting the function of the loop. If you instead use the indexers, it should allow you to alter the collection, since you are not impacting the loop (number to number):
Dim i As Integer
Dim c As ContentControl
For i = 1 To d.ContentControls.Count
Set c = d.ContentControls(i)
c.Delete
Next i
I have the following code:
Dim dicMyHash As Dictionary
Dim rngMyRange As Range
' A1 is empty - although the outcome is the same in any case
Set rngMyRange = Range("A1")
Set dicMyHash = New Dictionary
dicMyHash.Add Key:=rngMyRange(1), Item:=0
Debug.Print dicMyHash.Exists(rngMyRange(1).Value) ' returns False
Debug.Print rngMyRange(1) = rngMyRange(1).Value ' returns True
This behavior is somewhat unexpected. Is there some type casting going on in the background? rngMyRange(1).Value property returns a variant, whereas rngMyRange(1) is rngMyRange.item(1), which is a range. However, casting rngMyRange(1) to Variant gives the same results..
Also, adding keys is by value (so a copy of rngMyRange(1) is passed as a key). But still I cannot get why .Exists does not find the key..
Thank you in advance!
So here, we have three different values being passed around:
The original range.
Range.Value, which is a variant.
The copy of (1) which is internal to the dictionary.
If you compare these with equal signs, they are all the same. But according to Dictionary.Exists they are all different.
Why? When you use an equal sign with an object, the equal sign forces the object to call its default property. The default property of Range is Range.Value, which is why r = r.Value and also r = r.Offset(0, 0).
But for a dictionary this isn't so smart. Think about it: Every call to Dictionary.Exists would cause every object used as a key to call its default property. This can get really expensive and it can potentially trigger a lot of side effects. So instead, Dictionary.Exists tests the following:
Are you comparing an object to a non-object? Automatic fail.
Are you comparing two non-ojects? Return a = b.
Are you comparing two objects? Return a Is b.
So r is not the same as r.Value, since one is an object and the other is a non-object. And if you make a copy of r, like with r.Offset(0, 0), those are not the same either since they still point to two different objects, even if the objects have identical contents.
This, on the other hand, will work, since you will make r into the same object as d.Keys(0):
Dim d As Scripting.Dictionary
Dim r As Range
Set r = [a1]
Set d = New Dictionary
d.Add r, 0
Set r = d.Keys(0)
Debug.Print d.Exists(r)
I think the reason of your situation is that rngMyRange is recognised as an two- dimensional array and both array dimensions are passed to your dictionary.
If you change the line which adding element into Dictionary into this one:
dicMyHash.Add Key:=rngMyRange(1).value, Item:=0
it starting to work as you expect- both check points return true.
You could additionally analyse this situation in Locals Window while debugging of your code.
I'm not sure how you are putting this to use, but this will return True:
Sub test()
Dim dicMyHash As Dictionary
Dim rngMyRange As Range
Set rngMyRange = Range("A1")
Set dicMyHash = New Dictionary
dicMyHash.Add Key:=rngMyRange(1).Value, Item:=0 ' assign it with Value
Debug.Print dicMyHash.Exists(rngMyRange(1).Value)
End Sub
So then you'll have an item with a key of whatever's in A1.
I believe the reason it doesn't work without Value is that you are assigning a Range to the Key. It would make more sense to me if you were assigning the range to the Dictionary's Item.