Problem with a Dictionary in a Class

[Manuel Cavero]

Hello everyone:

I have two differents subs, each one calls to a different class to build the same object. The unique difference between both is the type of item used to load the dictionary inside the class. Let's have a look on the first one:

In the first one the dictionary is located inside a SUB procedure Añadir (add in English):

Option Explicit
Private Valores As Scripting.Dictionary
Private y As Integer
----------------------------------------------
Private Sub Class_Initialize()
    Set Valores = New Scripting.Dictionary
End Sub
----------------------------------------------
Private Sub Class_Terminate()
    Set Valores = Nothing
End Sub
----------------------------------------------
Public Sub Añadir(Valor As Integer)
    With Valores
        If .Exists(y) Then
            If Valor = 1 And .Item(y) > 0 Then
                .Item(y) = .Item(y) + 1
            ElseIf Valor = 1 And .Item(y) < 0 Then
                y = y + 1
                .Add y, Valor
            ElseIf Valor = -1 And .Item(y) < 0 Then
                .Item(y) = .Item(y) - 1
            ElseIf Valor = -1 And .Item(y) > 0 Then
                y = y + 1
                .Add y, Valor
            End If
        Else
            .Add y, Valor
        End If
    End With
End Sub

In the second one, the dictionary is located inside the procedure Let Property Añadir (add in English):

Option Explicit
Private Valores As Scripting.Dictionary
Private y As Integer
----------------------------------------------
Private Sub Class_Initialize()
    Set Valores = New Scripting.Dictionary
End Sub
----------------------------------------------
Private Sub Class_Terminate()
    Set Valores = Nothing
End Sub
----------------------------------------------
Public Property Let Añadir(Valor As Integer)
    With Valores
        If .Exists(y) Then
            If Valor = 1 And .Item(y) > 0 Then
                .Item(y) = .Item(y) + 1
            ElseIf Valor = 1 And .Item(y) < 0 Then
                y = y + 1
                .Add y, Valor
            ElseIf Valor = -1 And .Item(y) < 0 Then
                .Item(y) = .Item(y) - 1
            ElseIf Valor = -1 And .Item(y) > 0 Then
                y = y + 1
                .Add y, Valor
            End If
        Else
            .Add y, Valor
        End If
    End With
End Property

When the code is initialized in the first case the count property of dictionary = 0, but in the second case the count property of dictionary = 1.

How could I avoid this?

 

[RoryA]

I can't reproduce that. How exactly are you testing the count?

 

[Manuel Cavero]

Hi RoryA this the code for the 1st sub. In this case inside the class, there are subs and fuctions:

Sub Ejemplo1()
Dim Valor As Variant
Dim Rachas As CRachas1
Dim Promedio As Double
Dim Desviación As Double
Dim RPromedio As Range
Dim RDesviación As Range
Dim RSecuencia As Range
Dim RResumen As Range
Dim Temporal() As Variant
Dim Prueba() As Variant
'Asigno valor a las variables
With ThisWorkbook.Sheets("Hoja1")
    .Range("RDatos1").ClearContents
    Temporal = .Range("B3:B13").Value
    Set RPromedio = .Range("D3")
    Set RDesviación = .Range("E3")
    Set RSecuencia = .Range("C3")
    Set RResumen = .Range("F3")
End With
Set Rachas = New CRachas1
'Carga los valores en la clase
For Each Valor In Temporal
    If Valor > 0 Then Rachas.Añadir (1) Else Rachas.Añadir (-1)
    RPromedio.Value = Rachas.Promedio
    RDesviación.Value = Rachas.Desviación
    RSecuencia.Value = Rachas.Actual
    Set RPromedio = RPromedio.Offset(1, 0)
    Set RDesviación = RDesviación.Offset(1, 0)
    Set RSecuencia = RSecuencia.Offset(1, 0)
Next Valor
'Imprime la matríz del resúmen de la secuencia
Set RResumen = RResumen.Resize(Rachas.Cuenta)
RResumen.Value = Application.WorksheetFunction.Transpose(Rachas.Secuencia)
End Sub

In the 2nd, I remind you the class has properties, but does excatly the same as in the first one:

Sub Ejemplo2()
Dim Valor As Variant
Dim Rachas As CRachas2
Dim Promedio As Double
Dim Desviación As Double
Dim RPromedio As Range
Dim RDesviación As Range
Dim RSecuencia As Range
Dim RResumen As Range
Dim Temporal() As Variant
Dim Prueba() As Variant
'Asigno valor a las variables
With ThisWorkbook.Sheets("Hoja2")
    .Range("RDatos2").ClearContents
    Temporal = .Range("B3:B13").Value
    Set RPromedio = .Range("D3")
    Set RDesviación = .Range("E3")
    Set RSecuencia = .Range("C3")
    Set RResumen = .Range("F3")
End With
Set Rachas = New CRachas2
'Carga los valores en la clase
For Each Valor In Temporal
    If Valor > 0 Then Rachas.Añadir = 1 Else Rachas.Añadir = -1
    RPromedio.Value = Rachas.Promedio
    RDesviación.Value = Rachas.Desviación
    RSecuencia.Value = Rachas.Actual
    Set RPromedio = RPromedio.Offset(1, 0)
    Set RDesviación = RDesviación.Offset(1, 0)
    Set RSecuencia = RSecuencia.Offset(1, 0)
Next Valor
'Imprime la matríz del resúmen de la secuencia
Set RResumen = RResumen.Resize(Rachas.Cuenta)
RResumen.Value = Application.WorksheetFunction.Transpose(Rachas.Secuencia)
End Sub

And the test for both procedures:
1st: https://uploadfiles.io/92zni
2nd: https://ufile.io/5kmlw

 

[Manuel Cavero]

I forgot to show you the test:

1st case:

https://files.fm/u/p29ckng5#/view/case1.jpg

2nd case:

https://files.fm/u/wd2djfwa#_

 

[RoryA]

I can't replicate that from the code you have posted. Can you post the complete class or, preferably, a sample workbook rather than a picture?

 

[Manuel Cavero]

Hi RoryA

I see the problem and its not vinculate to a Property or a Sub, when the class code its initialized, every single procedure its tested and its executed. This not happens when the event class initialize and runs a sub or a function procedures

Thanks a lot for your help!!!