Setting graph series in excel VBA with Dictionary Keys - vba

Question

Objective:
Dynamically generating a (100% Stacked) graph based on data in a spreadsheet.
Conditions:
I have a list sites with repetitive milestones (each site uses the same 4 milestones, but the milestones differ between projects. This functionality will be used in the trackers for several projects).
Current State:
It's drawing the stacked barchart as desired, but I cant seem to get the legend (series) to be renamed to the unique keys in the dictionary that is being built from the identified milestones.
Data Setup:
Columns X3 and beyond has the list of milestones. there are 40 records (2 blank lines) with 4 unique values. The d1 dictionary contains the unique 4 values as displayed by the output into column R (for testing only).
Image: List of data and location/milestones
All code pertaining to drawing the graph:
With Worksheets("Sheet1")
.Columns.EntireColumn.Hidden = False 'Unhide all columns.
.Rows.EntireRow.Hidden = False 'Unhide all rows.
.AutoFilterMode = False
lastrow = Range("W" & Rows.Count).End(xlUp).Row
'If MsgBox("Lastrow is: " & lastrow, vbYesNo) = vbNo Then Exit Sub
End With
Dim MyLocationCount As Integer
Dim MyMilestoneCount As Integer
'Use VbA code to find the unique values in the array with locations.
'GET ARRAY OF UNIQUE LOCATIONS
Worksheets("Sheet1").Range("W3:W" & lastrow).Select
Dim d As Object, c As Range, k, tmp As String
Set d = CreateObject("scripting.dictionary")
For Each c In Selection
tmp = Trim(c.Value)
If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1
Next c
For Each k In d.Keys
Debug.Print k, d(k)
MyLocationCount = MyLocationCount + 1
Next k
Range("U1:U" & d.Count) = Application.Transpose(d.Keys) '<-- For verification of the locations keys only.
'MsgBox (MyLocationCount)
'SET ARRAY CATEGORY VALUES
Dim d3 As Object
Set d3 = CreateObject("scripting.dictionary")
x = 0
Do
x = x + 1
d3.Add key:=x, Item:=1
'MsgBox "Key " & x & ": " & d3(x) & " Key Count: " & d3.Count
Loop Until x = MyLocationCount
Dim k3 As Variant
For Each k3 In d3.Keys
' Print key and value
Debug.Print k3, d3(k3)
Next
'------------
Range("T1:T" & d3.Count) = Application.Transpose(d3.Items)'<-- For verification of the locations items only.
'GET ARRAY OF UNIQUE MILESTONES
Worksheets("Sheet1").Range("X3:X" & lastrow).Select
Dim d1 As Object, c1 As Range, k1, tmp1 As String
Set d1 = CreateObject("scripting.dictionary")
For Each c1 In Selection
tmp1 = Trim(c1.Value)
If Len(tmp1) > 0 Then d1(tmp1) = d1(tmp1) + 1
Next c1
For Each k1 In d1.Keys
Debug.Print k1, d1(k1)
MyMilestoneCount = MyMilestoneCount + 1
Next k1
Range("R1:R" & d1.Count) = Application.Transpose(d1.Keys) '<-- For verification of the milestone keys only.
ActiveSheet.ChartObjects("Chart 2").Activate
'Delete all current series of data.
Dim n As Long
With ActiveChart
For n = .SeriesCollection.Count To 1 Step -1
.SeriesCollection(n).Delete
Next n
End With
'==== START PROBLEM AREA =====
'Loop the XValues and Values code as many times as you have series. make sure to increment the collection counter. Use array values to hardcode the categories.
x = 0
Do Until x = MyMilestoneCount
With ActiveChart.SeriesCollection.NewSeries
.XValues = Array(d.Keys)
.Values = Array(d3.Items)
x = x + 1
End With
'NAME MILESTONE
'MsgBox (d1.keys(x))
ActiveChart.FullSeriesCollection(x).Name = "=""Milestone " & x & """" '<==== THIS WORKS BUT IS NOT DESIRED.
'ActiveChart.FullSeriesCollection(x).Name = d1.Keys(x) '<==== THIS IS WHAT IM TRYING TO GET TO WORK.
Loop
'==== END PROBLEM AREA =====
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
'SET LEGEND SIZE
ActiveChart.Legend.Select
Selection.Left = 284.71
Selection.Width = 69.289
Selection.Height = 144.331
Selection.Top = 9.834
Selection.Height = 157.331
With ActiveSheet.ChartObjects("Chart 2").Chart.Axes(xlValue, xlPrimary)
'.Border.LineStyle = xlNone
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNone
End With
End Sub
Anyone any idea on how to use the d1 keys instead of the manual naming? (See the <=== arrows).
I have code on how to color each section of the barchart based on the data that is determined in the spreadsheet (see image). right now my main challenge is getting the series properly named.
Thanks and have a great day!
Okki