Dictionary, Collection or Array?

Danny54

Active Member
Joined
Jul 3, 2019
Messages
295
Office Version
  1. 365
Platform
  1. Windows
i have the following excel sheet and need to reformat the data from a vertical view to a horizontal one while lining up the data in the appropriate columns.

the vertical column is labeled Key and Value ("A:B")
the reformatted output is labeled to the right called Key, followed up by the keys values. ("D: and as many cols needed based on how many keys found in "A")
under that is all the values found while distributing the data in the appropriate color row.

I'm trying to learn Arrays, Dictionary and Collection functionality but need a better understanding.

Any suggestions?

Thanks


1575042689090.png
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Before starting this, in your result, You have a detail in the color blue, the output should be:
DC-No1 and DC-No
And in orange color it must be "DC-Yes1"

The macro should get the color of the cell to identify the corresponding row?

Try this

VBA Code:
Sub Dictionary_Array()
  Dim dic As Object, a As Variant, b As Variant
  Dim i As Long, j As Long, n As Long, lr As Long, r As Long
 
  Set dic = CreateObject("scripting.dictionary")
 
  n = 1
  j = 1
  lr = Range("A" & Rows.Count).End(xlUp).Row
  ReDim a(1 To lr, 1 To 3)
  For i = 2 To lr
    If Range("A" & i).Value <> "" Then
      If Not dic.exists(Range("A" & i).Value) Then
        dic(Range("A" & i).Value) = j               'fill dictionary (key and column)
        j = j + 1
      End If
      a(n, 1) = Range("A" & i).Value                'fill key
      a(n, 2) = Range("B" & i).Value                'fill value
      a(n, 3) = Range("A" & i).Interior.ColorIndex  'fill color
      n = n + 1
    End If
  Next
 
  'fill output
  ReDim b(1 To 5, 1 To dic.Count)
  For i = 1 To n - 1
    'get row to output
    Select Case a(i, 3)
      Case 6:  r = 2  'yellow
      Case 43: r = 3  'green
      Case 44: r = 4  'orange
      Case 33: r = 5  'blue
    End Select
    
    'get column to output
    j = dic(a(i, 1))
    
    'fill array b
    b(1, j) = a(i, 1)
    b(r, j) = a(i, 2)
  Next
 
  Range("F1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub
 
Upvote 0
You can also fill the header with the dictionary.
Example:

VBA Code:
Sub Dictionary_Array()
  Dim dic As Object, a As Variant, b As Variant
  Dim i As Long, j As Long, n As Long, lr As Long, r As Long
 
  Set dic = CreateObject("scripting.dictionary")
 
  n = 1
  j = 1
  lr = Range("A" & Rows.Count).End(xlUp).Row
  ReDim a(1 To lr, 1 To 3)
  For i = 2 To lr
    If Range("A" & i).Value <> "" Then
      If Not dic.exists(Range("A" & i).Value) Then
        dic(Range("A" & i).Value) = j               'fill dictionary (key and column)
        j = j + 1
      End If
      a(n, 1) = Range("A" & i).Value                'fill key
      a(n, 2) = Range("B" & i).Value                'fill value
      a(n, 3) = Range("A" & i).Interior.ColorIndex  'fill color
      n = n + 1
    End If
  Next
 
  'fill header with keys
  Range("F1").Resize(1, dic.Count).Value = dic.keys
 
  'fill output
  ReDim b(1 To 5, 1 To dic.Count)
  For i = 1 To n - 1
    'get row to output
    Select Case a(i, 3)
      Case 6:  r = 1  'yellow
      Case 43: r = 2  'green
      Case 44: r = 3  'orange
      Case 33: r = 4  'blue
    End Select
    
    'get column to output
    j = dic(a(i, 1))
    
    b(r, j) = a(i, 2)
  Next
 
  Range("F2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub
 
Upvote 0
Thanks so much for the quick response.
I messed around several days but only confused myself the longer I tried things. It looking like i need to invest some time in understanding arrays which leads to using dictionaries and collection.

The code works wonderfully.

Have a Great Week!
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,223,445
Messages
6,172,177
Members
452,446
Latest member
walkman99

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top