Problem with a Dictionary in a Class

Manuel Cavero

New Member
Joined
Feb 17, 2018
Messages
26
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):

Code:
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):

Code:
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?
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
35,397
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
I can't reproduce that. How exactly are you testing the count?
 

Manuel Cavero

New Member
Joined
Feb 17, 2018
Messages
26
Hi RoryA this the code for the 1st sub. In this case inside the class, there are subs and fuctions:

Code:
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:

Code:
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

 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
35,397
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
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

New Member
Joined
Feb 17, 2018
Messages
26
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!!!
 

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,417
Messages
5,511,233
Members
408,831
Latest member
heidiussel

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...
Top