How to remove Similar Keys in Dictionary - vba

Let's say I have a dictionary with the following key value pairs.
Key/Value 1: Bob/Number
Key/Value 2: Bobby/Number
I'm trying to remove the key/value pair where the key (Bob) appears in part of another key (Bobby) and keep the latter.
I tried a nested loop and the Instr function to remove keys with names that appear in other keys. This method removed all the keys, as it eventually compared the key with itself.
Is there some method or function I can use to complete this task?
I'm not looking for anyone to provide code. I'm trying to address this conceptually.
I figured it out. I created a counter variable called similar words and removed the key when it exceeded two.
dict_keys = dict.key
For Each key In dict_keys
Dim similar_words As Integer
similar_words = 0
For Each search_key In dict_keys
If InStr(1, search_key, temp_key, 1) > 0 Then
similar_words = similar_words + 1
If similar_words > 1 Then
dict.Remove (key)
End If
End If
Next search_key
Next key

Related

How to map duplicate items to duplicate keys

First question on StackOverflow, please tell me how to improve. Also new to programming so problem may be simple, took me multiple hours to solve
I have two columns contained in a table, column X and column Y. Column X contains keys, column Y contains items. The columns are related by row. The item on row Z in Y should be mapped to the key on the same row in X. There can be more than one unique item per key, but only one unique key per item. All values in both columns occur an unknown amount of times. The task is to come up with an efficient mapping that provides easy access to all unique items corresponding to a specific key.
Please see my solution below. The function is called teamgroup and is part of a larger program, so there are inputs from other functions. What has not been included in my code is that the table is sorted by column X and that unique keys from column X are stored in a separate array, keys. IsInArray is also a separate function.
'Set keys
For i = 1 To UBound(keys)
With dict
.Add keys(i, 1), tmp
End With
Next i
'Group values by key
For Each kee In dict.keys
For i = 2 To lastrow
If kee = tbl.Range(i, keycol).Value Then
If IsInArray(tbl.Range(i, itemcol).Value, dict.Item(kee)) Then
Else
ReDim Preserve tmp(1 To UBound(tmp) + 1)
tmp(UBound(tmp)) = tbl.Range(i, itemcol).Value
dict.Remove (kee)
dict.Add (kee), tmp
End If
Else
End If
Next i
ReDim tmp(0)
Next
Set teamgroup = dict
End Function
The data is as follows:
X Y
56 6070
56 6070
55 6021
55 6024
56 6054
0 6050
There is no required form of the output but it should allow easy access to the items mapped to a specific key. I believe the dictionary to be a good tool for that. In this instance, an input of "56" should output an array, or similar, containing 6070 and 6054.
The end result of my code is a dictionary with unique keys mapping to items containing arrays with unique values from column Y.
My feeling is that this is an inefficient and convoluted way to solve the problem, so I would like to receive input on how it could be done better.

Remove elements in an arraylist that exist in another arraylist

i have 2 array list, dateListDead and dateListNotMinggu. Both is DateTime List of Array. This is the ilustration of the date value in list of array
The arrayList value
its supposed to remove specific element that exist in other array list.
so far i tried, this code it's not working.
Dim d, x As Integer
For x = 0 To dateListDead.Count - 1
For d = 0 To dateListNotMinggu.Count - 1
If dateListNotMinggu(d) = dateListDead(x) Then
dateListNotMinggu.RemoveAt(d)
End If
Next
Next
the error is : index out of range. how could it be ? i define the parameter of end looping base on arraylist.count -1
The main is that you are using a For loop from the first index to the last index but you don't account for the change of index when you remove a value. If there might be multiple values then you should start and the end rather than the beginning. In that case, removing an item won't affect the indexes of the items you are yet to test. If there can only be one match then you should be exiting the loop when you find one.
Either way, while you don't have to, I would suggest using a For Each loop on the outside. If you want to perform an action for each item in a list then that's exactly what a For Each loop is for. Only use a For loop if you need to use the loop counter for something other than accessing each item in turn.
For multiple matches:
For Each dateDead As Date In dateListDead
For i = dateListNotMinggu.Count - 1 To 0 Step -1
If CDate(dateListNotMinggu(i)) = dateDead Then
dateListNotMinggu.RemoveAt(i)
End If
Next
Next
For a single match:
For Each dateDead As Date In dateListDead
For i = 0 To dateListNotMinggu.Count - 1
If CDate(dateListNotMinggu(i)) = dateDead Then
dateListNotMinggu.RemoveAt(i)
Exit For
End If
Next
Next
Note that I have also cast the Date values as that type for comparison, which is required with Option Strict On. Option Strict is Off by default but you should always turn it On because it will help you write better code by focusing on data types.
Also, the code above would work with a List(Of Date) as well as an ArrayList but the casts would not be required with a List(Of Date). That's one of the advantages of using a generic List(Of T) over an ArrayList, which paces no restrictions on what it can contain.
If you really must use a For loop because that's what your homework assignment says then it would look like this:
For i = 0 To dateListDead.Count - 1
For j = dateListNotMinggu.Count - 1 To 0 Step -1
If CDate(dateListNotMinggu(j)) = CDate(dateListDead(i)) Then
dateListNotMinggu.RemoveAt(j)
End If
Next
Next
and this:
For i = 0 To dateListDead.Count - 1
For j = 0 To dateListNotMinggu.Count - 1
If CDate(dateListNotMinggu(j)) = CDate(dateListDead(i)) Then
dateListNotMinggu.RemoveAt(j)
Exit For
End If
Next
Next
Note that it is convention to use i as a first option for a loop counter, then j for the first nested loop, then k for the second nested loop. You should only use something else if you have good reason to do so. Remember that the loop counter doesn't represent the value in the list but rather its index. That's why you use i for index and not d for date or the like.
EDIT:
As per Jimi's comment below, the way this would usually be tackled is with a simple LINQ query. If you were using LINQ then you definitely wouldn't be using an ArrayList but rather a List(Of Date). In that case, the code would look like this:
dateListNotMinggu = dateListNotMinggu.Except(dateListDead).ToList()
If you were completely insane and wanted to use LINQ and ArrayLists then this would work:
dateListNotMinggu = New ArrayList(dateListNotMinggu.Cast(Of Date)().
Except(dateListDead.Cast(Of Date)()).
ToArray())
Take note that, as I replied in the comments, using LINQ will generate a new list, rather than changing the existing one.

Dictionary seemingly pulling same value for all keys (VBA)

I have a dictionary in which each key is a number 0-7. Each item is a collection of two number values. For each value in the dataset I am iterating through, the code checks which key 1-7 it belongs to, pulls the appropriate collection from the dictionary, adds the data to the collection, and inserts the collection back into the dictionary. It also adds every value to the 0 key in the dictionary, so that at the end the 0 key will contain a grand total i.e. the output should look like this:
Key:Value
0:100
1:20
2:10
3:10
4:20
5:10
6:5
7:25
The problem that I am having is that the output is something like:
Key:Value
0:100
1:100
2:100
3:100
4:100
5:100
6:100
7:100
It seems like each time I pull a collection from the dictionary using a key it, pulls the same collection regardless of key and then adds the data to that collection.
Dictionary:
For region = 0 To 7
regDict.Add region, blankColl
Next region
Adding items:
thisRegion = 'some number 1-7 found elsewhere
' pull the collection from the regDict
Set subtotalColl = regDict.Item(thisRegion)
subtotalSales = subtotalColl("Item") + thisSales
subtotalColl.Remove ("Item")
subtotalColl.Add Item:=subtotalSales, Key:="Item"
' replace the collection for thisRegion with the new one
regDict.Remove thisRegion
regDict.Add thisRegion, subtotalColl
' ----------- "region 0" gets every record no matter
' ----------- what the region of the record is
' pull the collection at 0 from the regDict
Set zeroSubtotalColl = regDict.Item(0)
subtotalSales = zeroSubtotalColl("Item") + thisSales
zeroSubtotalColl.Remove ("Item")
zeroSubtotalColl.Add Item:=subtotalSales, Key:="Item"
' replace the collection for Region 0 with the new one
regDict.Remove 0
regDict.Add 0, zeroSubtotalColl
The problem is that when I check the dictionary after all of this is done, every collection contains the same values! Even if I debug within this, zeroSubtotalColl from regDict(0) contains the the "new" value that I just put back into regDict(thisRegion) as subtotalColl.
Any help much appreciated.
blankColl is always a reference to the same collection, and you add it for each key, so all the "values" point to the same object.
Current:
Set regdict = CreateObject("scripting.dictionary")
Set blankColl = New Collection 'guessing here what you did...
For region = 0 To 7
regdict.Add region, blankColl
Next region
regdict(1).Add "hello"
Debug.Print regdict(7).Count '>>1 oops - should be empty!
Fix:
For region = 0 To 7
regdict.Add region, New Collection
Next region
regdict(1).Add "hello"
Debug.Print regdict(7).Count '>>0 still empty!

How to retrieve the value in a Dictionary based on key in VBA

I have a dictionary as such:
Set Desk = CreateObject("Scripting.Dictionary")
For Index = 1 To NoOfDesks
Desk.Add Cells(15 + Index, 4).Value, Index
Next
I am interested in getting the value based on the index. I tried doing this:
MsgBox Desk.Items()(1)
But I am not able to get the Value. It is returning a integer. It should be a string. Need some guidance on this.
You're getting exactly what you asked for: when you added the items, you specified Cells(15 + Index, 4) for a Key, and Index for an Item. Index being an Integer, you're getting an Integer.
If possible, add a reference to Microsoft Scripting Runtime instead of late-binding with CreateObject: you'll get IntelliSense, which makes it much easier to work with an unfamiliar API:
Your code would look like this:
Set Desk = New Dictionary
For Index = 1 To NoOfDesks
Desk.Add Index, Cells(15 + Index, 4).Value
Next
One thing to note, is that dictionary keys must be unique - you're [un]lucky to not have duplicates in column 4, otherwise it would be quite apparent that you have inverted the dictionary's key and value.
try this:
Sub test()
Dim Desk As Object, NoOfDesks&, Index&, Key As Variant
Set Desk = CreateObject("Scripting.Dictionary")
NoOfDesks = 100
For Index = 1 To NoOfDesks
Desk.Add Cells(15 + Index, 4).Value, Index
Next
For Each Key In Desk
Debug.Print Key, Desk(Key)
Next
End Sub

How to use TypedDataTable.Rows.Find(key as object) to find a row which has a composite key?

I have a TypedDataTable called CamerasDT which has a composite Primary Key of GroupId and CameraId. I want to use TypedDataTable.Rows.Find(key as object) to return a specific row by GroupId and CameraId. I don't seem to be able to find a way to send primary key to the find function. Any help is appreciated.
Use the one of the overloads for the Find method to pass an array of Objects that corresponds to the primary key values you're searching for.
Example from the MSDN article I linked:
The following example uses the values of an array to find a specific
row in a collection of DataRow objects. The method assumes that a
DataTable exists with three primary key columns. After creating an
array of the values, the code uses the Find method with the array to
get the particular object that you want.
Private Sub FindInMultiPKey(ByVal table As DataTable)
' Create an array for the key values to find.
Dim findTheseVals(2) As Object
' Set the values of the keys to find.
findTheseVals(0) = "John"
findTheseVals(1) = "Smith"
findTheseVals(2) = "5 Main St."
Dim foundRow As DataRow = table.Rows.Find(findTheseVals)
' Display column 1 of the found row.
If Not (foundRow Is Nothing) Then
Console.WriteLine(foundRow(1).ToString())
End If
End Sub
In your case you'd pass an Object array with values to search for in your GroupId and CameraId fields.