CODEWITHSUNDEEP
excelvbadictionary
David
David

Reputation: 45

Check if a key is in the dictionary: dictionary.exists(key) adds the key

I thought to use the dict.Exists(key) method to check if a key is in the dictionary.

The problem is that when checking it, the key is automatically added to the dictionary.

Function getContracts(wb As Workbook) As Dictionary
   Dim cData As Variant, fromTo(1 To 2) As Variant
   Dim contracts As New Dictionary, ctrDates As New Collection
   Dim positions As New Dictionary, p As Long, r As Long
   Dim dataSh As String, i As Long
   
   dataSh = "Export"
   
   cData = wb.Worksheets(dataSh).UsedRange
   
   For i = LBound(cData) To UBound(cData)
      fromTo(1) = cData(i, 1)
      fromTo(2) = cData(i, 2)
      Set ctrDates = Nothing
      If IsDate(fromTo(1)) And IsDate(fromTo(2)) Then
         If Not contracts.Exists(cData(i, 3)) Then ' Here it detects correctly that the key doesn't exist
            ctrDates.Add fromTo 
            contracts.Add cData(i, 3), ctrDates ' And here it fails because the key just got added by .Exists()
         Else
            Set ctrDates = contracts(cData(i, 3))
            ctrDates.Add fromTo
            contracts(cData(i, 3)) = ctrDates
         End If
      Else
         Debug.Print "Not a valid date in line " & i
      End If
      
   Next i
   
End Function

Upvotes: 2

Views: 1429

Answers (3)

Ricards Porins
Ricards Porins

Reputation: 384

Possible Solution:

I had the same issue, this tends to happen when the compare more has not been set. I have not dug any deeper into this as the issue cannot always be replicated and the documentation around .Exists() and .CompareMode isn't that thorough source.

(as everyone has said you should enable the Microsoft Scripting Runtime reference for early binding)

When creating a new dictionary set its .CompareMode to vbBinaryCompare this will set a more strict compare mode and also in my case fixes the .Exists() bug. Do note that you can only set .CompareMode on an empty dictionary

Dim NewDictionary As New Scripting.Dictionary
NewDictionary.CompareMode = vbBinaryCompare

If NewDictionary.Exists(key) Then
'do things
End If

Upvotes: 0

VBasic2008
VBasic2008

Reputation: 54807

Collections of Date Pairs in a Dictionary

  • A reference to the Microsoft Scripting Runtime library is necessary for this to work.
Option Explicit

Sub GetContractsTEST()

    Const dName As String = "Export"

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)

    Dim Contracts As Scripting.Dictionary: Set Contracts = GetContracts(dws)
    If Contracts Is Nothing Then Exit Sub

    Dim Key As Variant, Item As Variant
    For Each Key In Contracts.Keys
        Debug.Print Key
        For Each Item In Contracts(Key)
            Debug.Print Item(1), Item(2)
        Next Item
    Next Key

End Sub

Function GetContracts(ByVal ws As Worksheet) As Scripting.Dictionary
    Const ProcName As String = "GetContracts"
    On Error GoTo ClearError

    Dim cData As Variant: cData = ws.UsedRange.Value
    Dim fromTo(1 To 2) As Variant

    Dim Contracts As New Scripting.Dictionary
    Contracts.CompareMode = TextCompare
    
    Dim r As Long

    For r = LBound(cData) To UBound(cData)
        fromTo(1) = cData(r, 1)
        fromTo(2) = cData(r, 2)
        If IsDate(fromTo(1)) And IsDate(fromTo(2)) Then
            If Not Contracts.Exists(cData(r, 3)) Then
                Set Contracts(cData(r, 3)) = New Collection
            End If
            Contracts(cData(r, 3)).Add fromTo
        Else
            Debug.Print "Not a valid date in line " & r
        End If
    Next r

    Set GetContracts = Contracts

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

Upvotes: 1

Storax
Storax

Reputation: 12167

You can shorten your code to

   For i = LBound(cData) To UBound(cData)
      fromTo(1) = cData(i, 1)
      fromTo(2) = cData(i, 2)
      Set ctrDates = Nothing
      If IsDate(fromTo(1)) And IsDate(fromTo(2)) Then
            If Not IsEmpty(contracts(cData(i, 3))) Then Set ctrDates = contracts(cData(i, 3))
            ctrDates.Add fromTo
            Set contracts(cData(i, 3)) = ctrDates

      Else
         Debug.Print "Not a valid date in line " & i
      End If
      
   Next i

If one changes a value at a key it will automatically add the key if it does not exist.

Further reading on dictionaries

PS: This might also circumvent the strange behaviour described in the comments as you do not use the exist method. But on the other hand I have never experienced such a strange behaviour when using dictionaries

Upvotes: 1

Related Questions