I am going crazy with vba dictionaries, as the Exists() method makes no sense.

I though you can use the dict.Exists(key) method to check if a key is in the dictionary without further actions. The problem is that when checking it, the key is automatically added into the dictionary. It really makes no sense!

Here's my code. Am I doing something wrong?

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

CodePudding user response：

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

CodePudding user response：

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