These are the macro's behind the sheet.
Option Explicit
Dim mvOut As Variant
Dim wsIn As Worksheet, wsGD As Worksheet
Sub SetupGraph()
Set wsIn = Sheets("Input") '<<<< Modify if required
Set wsGD = Sheets("Graph Data")
PrepareData 1
MakeGraph 2
ChartColorsApply 3
Set wsIn = Nothing
Set wsGD = Nothing
End Sub
Sub PrepareData(i As Integer)
' Prepare data from Input sheet to GraphData sheet
Dim chBS As Chart
Dim rB As Range, rO As Range, r1st As Range, rf As Range
Dim lR As Long, UBo As Long
Dim iBatch As Integer, iReact As Integer
Dim vGD As Variant
Set chBS = Charts("Batch Schedule")
Set rB = wsIn.Range("2:2") '<<<< Set to row 2 where headings are
Set rO = rB.Find("batch number", after:=rB.Cells(1, wsIn.Columns.Count))
If rO Is Nothing Then
MsgBox "Can't find 'Batch Number' in header row", vbCritical
Exit Sub
End If
Set r1st = rO
iReact = 0
Do 'count number of reactors
iReact = iReact + 1
Set rO = rB.FindNext(after:=rO)
Loop While rO.Address <> r1st.Address
ReDim vOut(1 To 7, 1 To iReact)
UBo = iReact
'now process each reactor
iReact = 0
Set rf = rB.Find("batch number", after:=rB.Cells(1, wsIn.Columns.Count))
Set rf = rO
Do '
Set rO = rf.CurrentRegion
iReact = iReact + 1
'get reactor number from header
vOut(1, iReact) = "R" & Trim(Mid(rO.Cells(1, 2), 9, InStr(1, rO.Cells(1, 2), "(") - 9))
'get start and end dates & time
vOut(3, iReact) = CDate(rO.Cells(3, 2))
vOut(4, iReact) = CDate(rO.Cells(3, 3))
vOut(6, iReact) = CDate(rO.Cells(3, 4) + rO.Cells(3, 5))
'get batch duration
vOut(2, iReact) = (vOut(6, iReact) - (vOut(3, iReact) + vOut(4, iReact))) * 24
'get number of batches
vOut(5, iReact) = rO.Rows.Count - 2
'get last date for reactor
vOut(6, iReact) = vOut(6, iReact) + (vOut(5, iReact) - 1) * vOut(2, iReact) / 24
'get range of batch numbers (first and last)
vOut(7, iReact) = rO.Cells(3, 1).Address & ":" & rO.Cells(rO.Rows.Count, 1).Address
Set rf = rB.FindNext(after:=rf)
Loop While rf.Address <> r1st.Address
' Output the array to the graph data sheet
With wsGD.Range("C2").CurrentRegion
.Clear
.Value = vOut
End With
' Set up graph data
'get max number of batch runs
For iReact = 2 To UBo
If vOut(5, iReact) > iBatch Then iBatch = vOut(5, iReact)
Next iReact
'resize the graphdata array to number of reactors by max number of batches plus headers plus 0 row
ReDim vGD(1 To iBatch + 3, 1 To UBo)
For iReact = 1 To UBo
'get reactor name
vGD(1, iReact) = vOut(1, iReact)
'get start date & time
vGD(2, iReact) = vOut(3, iReact) + vOut(4, iReact)
vGD(3, iReact) = 0
' fill each batch duration
For lR = 4 To vOut(5, iReact) + 3
vGD(lR, iReact) = vOut(2, iReact) / 24
Next lR
Next iReact
' Output the array to the graph data sheet
With wsGD.Range("C11")
.CurrentRegion.Clear
.Resize(UBound(vGD, 1), UBound(vGD, 2)).Value = vGD
End With
Set chBS = Nothing
Set rB = Nothing
Set rO = Nothing
End Sub
Sub MakeGraph(i As Integer)
'
' MakeGraph Macro
' Make horizontal stacked chart
'
'
Dim sName As String
Dim rGIn As Range
Dim iReact As Integer
' delete old graph
Application.DisplayAlerts = False
Sheets("Batch Schedule").Delete
Application.DisplayAlerts = True
wsGD.Activate
Set rGIn = wsGD.Range("c11").CurrentRegion
iReact = rGIn.Columns.Count
rGIn.Select
' create new graph in data sheet and set up
wsGD.Shapes.AddChart2(297, xlBarStacked).Select
With ActiveChart
.PlotBy = xlRows
sName = .Name
sName = Trim(Replace(sName, ActiveSheet.Name, ""))
.FullSeriesCollection(1).Formula = "=SERIES(,'Graph Data'!R11C3:R11C" & 2 + iReact & ",'Graph Data'!R12C3:R12C" & 2 + iReact & ",1)"
.Axes(xlValue).MinimumScale = wsGD.Range("a13")
.Axes(xlValue).MaximumScale = wsGD.Range("a15")
With .Axes(xlValue)
.MajorUnit = 1
.MinorUnit = 0.5
.TickLabels.NumberFormat = "d-m;@"
End With
.HasLegend = False
.ChartTitle.Caption = "Reactor batch planning"
' move to new graph sheet
.Location Where:=xlLocationAsNewSheet
End With
ActiveSheet.Name = "Batch Schedule"
End Sub
Sub ChartColorsApply(j As Integer)
' Set the colours to alternating light blues
' Add the batch numbers in the batches on the graph
Dim i As Integer, iCol As Integer, iBN As Integer, iR As Integer, iMax As Integer
Dim dBright As Double
Dim vLbl As Variant
Dim wsIn As Worksheet
Dim sN As String
Sheets("Batch Schedule").Select
With ActiveChart
'set alternating colours.
'The 1st group is the delay from start of graph _
in case batches don't start right away, and is made transparent
For i = 1 To .SeriesCollection.Count
Select Case True
Case i = 1
iCol = msoThemeColorBackground1
dBright = 0
Case i Mod 2 = 0
iCol = msoThemeColorAccent1
dBright = 0.8000000119
Case Else
iCol = msoThemeColorAccent1
dBright = 0.6000000238
End Select
With .FullSeriesCollection(i).Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = iCol
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = dBright
.Transparency = 0
If i = 1 Then .Transparency = 1
.Solid
End With
Next i
' put batchnumbers in every 5th batch
iBN = 5
sN = "Input"
Set wsIn = Sheets(sN)
If Not IsArray(mvOut) Then mvOut = wsGD.Range("C2").CurrentRegion.Value
For iR = 1 To UBound(mvOut, 2) ' for each reactor
vLbl = wsIn.Range(mvOut(7, iR))
iMax = UBound(vLbl, 1)
For i = 1 To iMax
If (i Mod iBN) = 0 Or i = 1 Or i = iMax Then
With .FullSeriesCollection(i + 1).Points(iR)
.ApplyDataLabels
.DataLabel.Formula = vLbl(i, 1)
End With
End If
Next i
Next iR
End With
End Sub
