```
Option Explicit
Public currchartrow As Long, chartno As Long
Sub Create_Charts()
Dim ntwk As Worksheet
Dim charts As Worksheet
Dim Chartgroup As String
Dim i As Long
Dim x As Long
Dim y As Long
Dim startrow As Long
Dim ChartRange As Range
Dim LeftPos As Long, TopPos As Long
Dim LastRow As Long
Dim ChartTitle As String
Set ntwk = Worksheets("NTWK")
Set charts = Worksheets("NTWK - Charts")
' Delete Existing Charts if they Exist
With charts.ChartObjects
If .Count > 0 Then
.Delete
LastRow = charts.Cells(charts.Rows.Count, "B").End(xlUp).Row
charts.Rows("1:" & LastRow).Delete
End If
End With
' Determine last row of data
LastRow = ntwk.Cells(ntwk.Rows.Count, "B").End(xlUp).Row
LeftPos = 51
TopPos = 30
' Determine the Chart Grouping and Number of Charts per Group
currchartrow = 1
' Determine Left and Top Position of Chart
LeftPos = 51
TopPos = 30
i = 2
' i = 4
For i = 2 To LastRow
With ntwk
' x = i
If ntwk.Cells(i, 2).Interior.ColorIndex = 36 Then
Chartgroup = .Cells(i, 2).Value
startrow = i + 1
x = startrow
End If
chartno = 0
Do Until ntwk.Cells(x, 2).Interior.ColorIndex = 36 And x > startrow And x <= LastRow
chartno = chartno + 1
If ntwk.Cells(x, 2).Interior.ColorIndex = 36 And x = startrow Then
Chartgroup = .Cells(i, 2).Value & " - " & .Cells(x, 2).Value
startrow = startrow + 1
chartno = chartno - 1
End If
x = x + 1
If x > LastRow Then
GoTo exitloop
End If
Loop
exitloop:
i = x - 1
chartno = chartno - 1
' Create Charts
For y = startrow To startrow + chartno
ChartTitle = ntwk.Cells(y, 2).Value & " - " & ntwk.Cells(y, 3).Value
charts.Cells(currchartrow, 2) = Chartgroup
Call MergeCenter
Set ChartRange = Sheets("NTWK").Range("D" & y & ":H" & y)
With charts.ChartObjects.Add _
(Left:=LeftPos, Width:=250, Top:=TopPos, Height:=150)
.Chart.SetSourceData Source:=ChartRange
.Chart.ChartType = xlLineMarkers
.Chart.HasLegend = False
.Chart.SeriesCollection(1).HasDataLabels = False
.Chart.SeriesCollection(1).MarkerSize = 8
.Chart.HasAxis(xlValue, xlPrimary) = True
.Chart.HasTitle = True
.Chart.ChartTitle.Text = ChartTitle
With .Border
.Color = RGB(79, 129, 189)
.Weight = 1.5
.LineStyle = xlContinuous
End With
End With
If y < startrow + chartno Then
LeftPos = LeftPos + 300
Else
LeftPos = 51
TopPos = TopPos + 210
currchartrow = currchartrow + 14
End If
Next y
End With
Next i
End Sub
```