excelvbadictionarymappingstoring-information

Excel VBA - Dictionary - storing and retrieving values


I am working on below table and with help of Excel VBA - Dictionary - I am trying to capture all the details - 1) First step is to search in "Results Out" Column - if the value is "No" - then we need to read all the values with their appropriate header. 2) So for 2nd record - i.e., Name = XYZ - we need to store all the details. Based on No. of Subjects column - we need to store value of all the subjects and their corresponding marks - will be used for further calculation and generate the "Result" column.

I got it partially working - like I am able to capture details - but not able to store details of all the subject and their marks:

Sr. No. Results Out?    Result  Name    Age No. of Subjects Subject Names   Marks
1           Yes          Pass   ABC      21       3          Maths           10
                                                             Science         26
                                                             History         34
2           No                  XYZ      10       2          Maths           24
                                                             Science         36

Below is the code that I have used that is partially working:

Public Sub test_dict()

Dim dict As New Scripting.dictionary
Set dict = New dictionary

sSheetIndex = 1
intTargetRow = 2

Set objUsedRange = Worksheets.Item(3).UsedRange

For Iter = 1 To objUsedRange.Columns.Count
   sCellName = objUsedRange.Cells(1, Iter)
   sCellValue = objUsedRange.Cells(intTargetRow, Iter)
   dict.Item(sCellName) = sCellValue

Next


For i = 0 To dict.Count - 1
    s = dict.Items()(i)
    Debug.Print dict.Keys()(i) & " " & dict.Items()(i)
    Debug.Print s
Next i

End Sub

Solution

  • Resolved the issue with below code - had to use 2 seperate dictionaries:

    Public Sub test_dict()
    
    Dim dict As New Scripting.dictionary
    Set dict = New dictionary
    
    sSheetIndex = 1
    intTargetRow = 2
    
    Set objUsedRange = Worksheets.Item(3).UsedRange
    
    For Iter = 1 To objUsedRange.Columns.Count
       sCellName = objUsedRange.Cells(1, Iter)
       sCellValue = objUsedRange.Cells(intTargetRow, Iter)
       dict.Item(sCellName) = sCellValue
    
        If sCellName = "Subject Names" Then
            Call test_dict_2
        End If
    
    Next
    
    For i = 0 To dict.Count - 1
        s = dict.Items()(i)
        Debug.Print dict.Keys()(i) & " " & dict.Items()(i)
        Debug.Print s
    Next i
    
    End Sub
    
    
    
    Public Sub test_dict_2()
    
    Dim dict_2 As New Scripting.dictionary
    Set dict_2 = New dictionary
    
    sSheetIndex = 1
    intTargetRow = row_counter
    
    Set objUsedRange = Worksheets.Item(3).UsedRange
    
    For Iter = 1 To objUsedRange.Columns.Count
       sHeader = objUsedRange.Cells(1, Iter)
       sCellValue = objUsedRange.Cells(intTargetRow, Iter)
    
        If sHeader = "No. of Subjects" Then
            mv_cnt = sCellValue
        End If
    
        If sHeader = "Subject Names" Then
    
            Dim a
            a = Iter + mv_cnt
            For Iter_2 = Iter To (a - 1)
    
                sHeader = objUsedRange.Cells(1, Iter)
                sCellName = objUsedRange.Cells(intTargetRow, Iter)
                sCellValue = objUsedRange.Cells(intTargetRow, Iter + 1)
                dict_2.Item(sCellName) = sCellValue
                intTargetRow = intTargetRow + 1
    
            Next
    
            intTargetRow = row_counter
    
        End If
    
    Next
    
    For i = 0 To dict_2.Count - 1
        s = dict_2.Items()(i)
        Debug.Print dict_2.Keys()(i) & " " & dict_2.Items()(i)
        Debug.Print s
    Next i
    
    Set dict_2 = Nothing
    
    End Sub