Create a dictionary with value from an Array - vba

Question

I am working on a report and trying to output my data like this
Input:
Output
I am thinking of using a dictionary with each key has multiple value of Items&their but i don't know how to implement.

Answer 1

Using a dictionary would not work for your chart example. A dictionary is used to hold ONLY TWO string values using a hashtable. An example of using a dictionary properly is using the two words "hello" and "a polite greeting to another human". The first string is for the word and the second is the definition of the word, just like a regular dictionary.
I would provide you with two better options. You could create a 2D array which holds all your values, but you would need to output the labels separately from the values. You could also create a file which holds the labels and the values for your chart.
If you need more help, please provide more information on what you are trying to do with the chart displayed. An array is better for calculations but a file is better for storing the values and displaying the chart.

Answer 2

Second answer would be to use a dictionary of dictionaries. Again input data is
With the following code
Sub DemoDictOfDict()
Dim rg As Range, rgHdr As Range
Dim dict As Dictionary
Dim sngDict As Dictionary
Dim wkb As Workbook, wks As Worksheet
Set wkb = ActiveWorkbook
Set wks = wkb.ActiveSheet
Set rg = wks.Range("A1").CurrentRegion
' Retrieving the header line from the data
Set rgHdr = rg.Rows(1).Offset(, 1).Resize(, rg.Columns.Count - 1)
Dim vHdr As Variant
vHdr = rgHdr.Value
Dim sngRow As Range
Dim sngCell As Range
Dim vdat As Variant
Dim k As Long
' Creating the dictionary which will be used
' to hold the dictionaries with the data
Set dict = New Dictionary
' Looping through the rows of the data
' as we are not using the listobject one has to use offset and resizte
For Each sngRow In rg.Offset(1).Resize(rg.Rows.Count - 1).Rows
' getting the number for different columns
' again listobject not used, so working with resizte and offset
vdat = sngRow.Offset(, 1).Resize(, sngRow.Columns.Count - 1)
' Creating the dictionary containing the numbers
Set sngDict = New Dictionary
For k = LBound(vHdr, 2) To UBound(vHdr, 2)
' Adding the values to the "inner" dictionary
sngDict.Add vHdr(1, k), vdat(1, k)
Next k
' Adding the dictionary to the dictionary
Set dict(sngRow.Cells(1, 1).Value) = sngDict
Next
' output to immediate windows
Dim outName As String, vDict As Dictionary
Dim key As Variant, i As Long
For i = 0 To dict.Count - 1
outName = dict.Keys(i)
Set vDict = dict.Items(i)
Debug.Print outName
For Each key In vDict.Keys
Debug.Print key, vDict(key)
Next
Next i
End Sub
you get the following output in the immediate window

Answer 3

First answer as said in one of my comments you could use Power Query to unpivot the data. As example data I took data like this
After unpivoting the data with PowerQuery (goto Data then From Table/Range, select the columns with Apple, Orange etc. in the Power Query Editor, select the tab Transform and there Unpivot columns) one gets
Then you pivot the data again and you get

Answer 4

Unless you're going to do something else with the collected data then there's no need for any intermediate data structure:
Dim data, r As Long, c As Long
data = ActiveSheet.Range("A3:D5").Value
For r = 2 To UBound(data, 1)
Debug.Print data(r, 1)
For c = 2 To UBound(data, 2)
Debug.Print data(1, c) & " " & data(r, c)
Next c
Debug.Print "Checked."
Next r

Answer 5

The location of the data should be the same as the picture to work.
Sub test()
Dim vDB As Variant
Dim vR() As Variant
Dim i As Long, r As Long, n As Long
Dim c As Integer, j As Integer
vDB = Range("a3").CurrentRegion
r = UBound(vDB, 1)
c = UBound(vDB, 2)
For i = 3 To r
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = vDB(i, 1)
For j = 2 To c
n = n + 1
ReDim Preserve vR(1 To n)
If vDB(i, j) = "" Then
vR(n) = "Checked"
Else
vR(n) = vDB(2, j) & Space(1) & vDB(i, j)
End If
Next j
Next i
Sheets.Add
Range("a1").Resize(n) = WorksheetFunction.Transpose(vR)
End Sub
Result Sheet