For Loop to build charts

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