For Loop to build charts - excel

Question

I have the following dataset:
I am trying to code a macro that builds a chart for each of the locations. I have created code that creates a new workbook, names the sheet, can create the first chart for Location 1, but I need the code to then loop back through and do the same for Location 2, Location 3, etc. Here is a sample chart below:
The hard part - Sites (Column A) will change. Some months I may have up to Location 10. I need the code to be dynamic enough to create a chart for each unique Site. As you'll see in the code, I'm creating a new workbook, creating the chart in the old file, and cut/paste into a tab in the new workbook. I then rename the worksheet based on Chart Title. I then need the code to loop back to the beginning and repeat the process for each unique location in Column A.
Here is the code:
Sub ChartBuilder()
Dim Wb As Workbook
Set Wb = ActiveWorkbook
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Wb.Path & "\Outputs.xlsx"
ActiveSheet.Name = "Results"
Wb.Activate
Sheets("Sheet1").Select
'88888 Loop ends below and Loop should come back here
ActiveSheet.Shapes.AddChart2(227, xlLine).Select
With ActiveChart
'Needs to be dynamic in both Chart Title Name and Data Range
'Column A is the Location Name - will have duplicates
'Column C has the weeks. Weeks are limited to Week 1, Week 2, Week 3, Week 4
'Column E thru I are the data columns that need to be displayed.
.ChartTitle.Text = ActiveSheet.Range("A2")
.SetSourceData Source:=Range("Sheet1!$C$2:$C$5,Sheet1!$E$2:$I$5")
ActiveChart.PlotBy = xlColumns 'Chart was flipping and I couldn't figure out why, so wrote code to flip it
Set Srs1 = ActiveChart.SeriesCollection(1)
Srs1.Name = ActiveSheet.Range("$E$1")
Set Srs2 = ActiveChart.SeriesCollection(2)
Srs2.Name = ActiveSheet.Range("$F$1")
Set Srs3 = ActiveChart.SeriesCollection(3)
Srs3.Name = ActiveSheet.Range("$G$1")
Set Srs4 = ActiveChart.SeriesCollection(4)
Srs4.Name = ActiveSheet.Range("$H$1")
Set Srs5 = ActiveChart.SeriesCollection(5)
Srs5.Name = ActiveSheet.Range("$I$1")
'Resizes chart
With ActiveChart.Parent
.Height = 300
.Width = 600
.Top = 100
.Left = 100
End With
End With
'Copy to new tab, name tab same as Chart Title
'Loop back to beginning for next filter
Dim OutSht As Worksheet
Dim Chart As ChartObject
Dim PlaceInRange As Range
Workbooks("Outputs.xlsx").Activate
Set OutSht = ActiveWorkbook.Sheets("Results") '<-- Output sheet
Set PlaceInRange = OutSht.Range("B2:J21") '<-- Output location
Wb.Activate
For Each Chart In Sheets("Sheet1").ChartObjects '<-- Loop charts
Chart.Cut 'Cut/paste charts
OutSht.Paste PlaceInRange
Next Chart
Workbooks("Outputs.xlsx").Activate
Worksheets("Results").Activate
ActiveSheet.Name = ActiveChart.ChartTitle.Text
Sheets.Add.Name = "Results"
'88888 Loop back to beginning
ActiveWorkbook.SaveAs Filename:=Wb.Path & "\" & Format(Now, "yyyymmdd") & " Outputs.xlsx"
Kill Wb.Path & "\Outputs.xlsx"
Wb.Activate
End Sub

Answer 1

The following code assumes that there are always four weeks per location. I'm not sure why the original code created an "Outputs.xlsx", just to subsequently delete it for a "YYYYMMDDOutputs.xlsx". I just went straight to the dated file name. I also did away with the "Results" tab and just made each chart it's own tab.
Quarterback Subroutine ChartAllLocations:
Public Sub ChartAllLocations()
Dim location As String, WB As Workbook, ws As Worksheet
Dim resultsWB As Workbook, data As Range, currLocation As Range
Dim headers As Range
Set WB = ThisWorkbook
Set ws = WB.Worksheets("Data")
Set resultsWB = ResultsWorkbook(WB.path)
Set headers = ws.Range("E1:I1")
locIdx = 2
Do
Set data = ws.Cells(locIdx, 1).Resize(4, 9)
ChartBuilder2 resultsWB, data, headers
locIdx = locIdx + 4
Loop While ws.Cells(locIdx, 1).Value <> ""
resultsWB.Worksheets("Sheet1").Delete
End Sub
Function for new Workook, ResultsWorkbook:
Private Function ResultsWorkbook(path As String) As Workbook
Dim output As Workbook
Dim ws As Worksheet
Set output = Workbooks.Add
output.SaveAs filename:=path & "\" & Format(Now, "yyyymmdd") & " Outputs.xlsx"
Set ResultsWorkbook = output
End Function
Function for building each chart ChartBuilder2:
Public Sub ChartBuilder2(WB As Workbook, data As Range, hdrs As Range)
Dim Chrt As Chart
Set Chrt = WB.Charts.Add(After:=WB.Worksheets(WB.Worksheets.Count))
Chrt.Name = data.Cells(1, 1)
Chrt.HasTitle = True
Chrt.ChartTitle.Text = data.Cells(1, 1)
Chrt.SetSourceData Source:=data.Cells(1, 5).Resize(4, 5)
Chrt.ChartType = xlLine
Chrt.PlotBy = xlColumns
Chrt.FullSeriesCollection(1).XValues = _
"={""Week 1"",""Week 2"",""Week 3"",""Week 4""}"
Chrt.Axes(xlValue).TickLabels.NumberFormat = "0%"
For srsIdx = 1 To 5
Chrt.SeriesCollection(srsIdx).Name = hdrs.Cells(1, srsIdx).Value
Next srsIdx
End Sub