Get existing item index in dictionary

[YasserKhalil]

Hello everyone

I have created a dictionary object and I am checking if the item already exists. If exists I need to get the index number of the item inside the dictionary

Untitled.png

I mean as for the first item for example 28-09-2019 .. if this date exists in the dictionary then to return the number 1 as this is the first item (I mean to return its index inside the dictionary)

Code: Select all

Debug.Print dic.Item(CStr(a(i, 1)))

This prints empty string .. as I used before

Code: Select all

If Not dic.Exists(CStr(a(i, 1))) Then
                   dic(CStr(a(i, 1))) = Empty

[snb]

Post a sample file.

https://www.snb-vba.eu/VBA_Dictionary_en.html" onclick="window.open(this.href);return false;

[YasserKhalil]

Thanks a lot snb. The code is too long and it will not help to post it.

[HansV]

Looping through the dictionary entries is an obvious solution.

Please note that both the Keys array and the Items array of a dictionary are 0-based, so the first item is number 0.

[YasserKhalil]

Thanks a lot Mr. Hans
I can solve it by storing a variable of the index instead of assigning to Empty
I will not loop through the Keys or Items to get the index of an existing item in the dictionary

[snb]

My answer is too sophisticated, so posting won't help either.

[YasserKhalil]

If your answer won't help me (in your opinion), may be helpful for others ..

[YasserKhalil]

This is too sample data that I need to transpose to table

The idea is to make the dates (unique dates) as headers for the tables
The column A would be unique too for the items in column A
The values to be put in the appropriate ITEM and DATE

[HansV]

A pivot table would be very suitable for that...

[YasserKhalil]

Thanks a lot. My issue is part of long code my tutor .. so the pivot table would not be suitable for me
Thanks a lot anyway.

[HansV]

Code: Select all

Sub Transform()
    Dim wshS As Worksheet
    Dim wshT As Worksheet
    Dim a As Variant
    Dim s As Long
    Dim t As Long
    Dim r As Range
    Dim c As Long
    Dim n As Long
    Application.ScreenUpdating = False
    Set wshS = Worksheets("Sheet1")
    a = wshS.UsedRange.Value
    Set wshT = Worksheets.Add(After:=wshS)
    t = 2
    n = 2
    wshT.Cells(1, 1).Value = "Item"
    wshT.Cells(2, 1).Value = a(1, 1)
    wshT.Cells(1, 2).Value = a(1, 2)
    wshT.Cells(2, 2).Value = a(1, 3)
    For s = 2 To UBound(a, 1)
        If a(s, 1) <> a(s - 1, 1) Then
            t = t + 1
            wshT.Cells(t, 1).Value = a(s, 1)
        End If
        Set r = wshT.Rows(1).Find(What:=a(s, 2), LookIn:=xlFormulas, LookAt:=xlWhole)
        If r Is Nothing Then
            n = n + 1
            wshT.Cells(1, n).Value = a(s, 2)
            c = n
        Else
            c = r.Column
        End If
        wshT.Cells(t, c).Value = a(s, 3)
    Next s
    wshT.UsedRange.Offset(ColumnOffset:=1).Sort Key1:=wshT.Cells(1, 2), Header:=xlNo, Orientation:=xlSortRows
    wshT.UsedRange.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

[YasserKhalil]

That's amazing Mr. Hans
In fact, I am not seeking for a solution in that way. I need to learn more about how to use the dictionaries in such situations, so I expect to find an answer using the dictionary approach.
Thanks a lot for awesome help all the time .. You are the BEST

[HansV]

[YasserKhalil]

So sorry if I was annoying .. Don't be annoyed and believe me, I like all your solutions.

[HansV]

I'm not annoyed, but since your problem is part of a larger piece of code, I cannot help you.

[YasserKhalil]

Thanks a lot anyway...
This is the whole code (may be useful for others)

Code: Select all

Const strUrl As String = "https://www.reuters.com/companies/api/getFetchCompanyFinancials/"

Sub GetData()
    Dim ws As Worksheet, sSection As String

    For Each ws In ThisWorkbook.Worksheets(Array("IS", "BS", "CF"))
        Select Case ws.Name
            Case "IS": sSection = "income"
            Case "BS": sSection = "balance_sheet"
            Case "CF": sSection = "cash_flow"
        End Select

        GetReuters ws, "tbl" & ws.Name, Sheets("Data").Range("B1").Value, sSection, Sheets("Data").Range("B2").Value
    Next ws
End Sub

Sub GetReuters(ByVal ws As Worksheet, ByVal tblName As String, ByVal sTicker As String, ByVal sSection As String, ByVal sTime As String)
    Dim a, ky, col As Collection, json As Object, data As Object, dic As Object, rng As Range, i As Long, k As Long, c As Long
    
    With CreateObject("MSXML2.ServerXMLHTTP.6.0")
        .Open "GET", strUrl & sTicker
        .send
        Set json = JSONConverter.ParseJson(.responseText)
    End With
    
    ReDim b(1 To 10000, 1 To 7)
    c = 1: b(1, c) = "Dates"

    Set data = json("market_data")("financial_statements")(sSection)(sTime)
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1

    For Each ky In data.Keys
        Set col = data(ky)
        a = CollectionToArray(col)
        k = k + 1
        b(k + 1, 1) = ky

        For i = LBound(a) To UBound(a)
            If Not dic.Exists(CStr(a(i, 1))) Then
                dic(CStr(a(i, 1))) = c
                c = c + 1

                b(1, c) = CStr(a(i, 1))
                b(k + 1, c) = a(i, 2)

            Else
                b(k + 1, dic.item(CStr(a(i, 1))) + 1) = a(i, 2)
            End If
        Next i

        Erase a
    Next ky

    Application.ScreenUpdating = False
        With ws
            On Error Resume Next
                .ListObjects(tblName).Delete
            On Error GoTo 0
            .Range("A1").Resize(k + 1, UBound(b, 2)).Value = b
            With .Range("A1").CurrentRegion
                Set rng = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
                rng.NumberFormat = "#,##0.00;(#,##0.00)"
                rng.Rows(1).Offset(-1).NumberFormat = "dd-mmm-yy"
                .Columns.AutoFit
            End With
            
            .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = tblName
        End With
    Application.ScreenUpdating = True
End Sub

Function CollectionToArray(ByVal c As Collection) As Variant()
    Dim a(), i As Long
    ReDim a(1 To c.Count, 1 To 2)

    For i = 1 To c.Count
        a(i, 1) = c.item(i)("date")
        a(i, 2) = c.item(i)("value")
    Next i

    CollectionToArray = a
End Function

[HansV]

Thanks, I'm afraid I'm not going to analyze all that. Sorry.

[YasserKhalil]

Never mind. This is a solution and I welcome any suggestions or corrections if you have a desire to do :)

[Doc.AElstein]

Hello Yasser,
I am a bit lost as to what is actually wanted or being discussed here.. But – going back to the first post and title question… Get existing item index in dictionary and as you said….

.... I need to learn more about how to use the dictionaries in such situations, so I expect to find an answer using the dictionary approach....

In the macro below..
Rem 2
This is using your uploaded sample1 test data, ( https://imgur.com/y9mYRE9" onclick="window.open(this.href);return false; ) , just the first 6 rows to created a dictionary object, Dik , which looks like your first post screen shot
https://imgur.com/cmRFkjK" onclick="window.open(this.href);return false;
https://imgur.com/0VwM44W" onclick="window.open(this.href);return false;
The last bit , 2c) , also gets the Keys array, my variable DikKeys() , ( which as Hans said is , like the Items array , 0-based, so the first item is number 0. ( But that is less relevant for what I am trying to show ** ) )
https://imgur.com/t4Zp5Fq" onclick="window.open(this.href);return false;

Note: Displayed in the VB Watch Window for the Dictionary is the Keys, not the Items

Rem 3 is Geting existing item index in dictionary
‘3c) is the main bit I am trying to show

I don’t think there is an in built way of getting at the Item number that you want from a Dictionary. But it is easy to get from Match

What Match does simplified is …

Integer position along of … Match([This] , [inside this 1 “width” thing] , [0])
( ** The integer number returned starts at 1, regardless of what the indicies are of the 1 “width” thing - so if , for example it was a 1 D array, it would make no difference if it started at indicie of 0 or 1 etc )

The [0] is just telling Match to look for the exact match

[This] would be in your case what Key you are looking the item number of

[inside this 1 “width” thing] is the second argument of Match which must be a one “width” thing. It can be a
column,
row,
a 1 row 2 D array,
a 1 column 2D array,
a 1 D array, like for example our keys array DikKeys()

If , in my code example, the Key you give in the first argument of Match,
is in the second argument , the Keys array DikKeys() ,
then match will return the position along of that key in DikKeys()

The first key has the position along of 1
The second key has the position along of 2
The third key has the position along of 3
…etc….

_.____

I suppose the jist of all I am trying to explain here is
Question: Get existing item index in dictionary, with a key of KeyX
Answer : like: = Match( KeyX , Keys() , 0 )

( Similarly , you can get the item number of any item , say , ItemX
like: = Match( ItemX , Items() , 0 ) )

Alan

Code: Select all

Sub CreatDikGetExistingItem() '  http://www.eileenslounge.com/viewtopic.php?f=27&t=34502
Rem 1 Create a Dik  '  https://excelmacromastery.com/vba-dictionary/
Dim Dik As Object: Set Dik = CreateObject("Scripting.Dictionary"): Let Dik.CompareMode = vbTextCompare
Rem 2 Fill Dik
' 2a) Data for Dik
Dim Aey() As Variant
 Let Aey() = Worksheets("Sheet1").Range("A1:C6").Value '
' 2b) Fill Dik with data
Dim Cnt
    For Cnt = 1 To 6 ' sample data only  - https://imgur.com/63acQNv - https://imgur.com/fcIrboC - https://imgur.com/EfGVMmd
     Dik.Add Key:=CStr(Aey(Cnt, 2)), Item:=Aey(Cnt, 1) & "  " & Aey(Cnt, 3)
    Next Cnt
' 2c) The keys array
Dim DikKeys() As Variant
 Let DikKeys() = Dik.keys() ' https://imgur.com/WcDjwVd
Rem 3 If exists get the index number of the item inside the dictionary
' 3a) Example
Dim Answer As Variant
 Let Answer = InputBox(prompt:="Input key to get item number of if it exists", Default:="2019-09-28")
' 3b)  Exists Method ' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/exists-method
    If Dik.exists(Answer) Then
    ' 3c) Use match to get at item number
    Dim KeyItmNmbr As Long
     Let KeyItmNmbr = Application.Match(Answer, DikKeys(), 0)
     MsgBox prompt:="For key  " & Answer & "  the item number is  " & KeyItmNmbr
    Else
     MsgBox prompt:="The key of " & Answer & " does not exist"
    End If
End Sub

[YasserKhalil]

Amazing trick Mr. Alan
Thanks a lot for the great solution.