Sub VarChart()
Dim chtNew As Chart
Dim rngColumnZero As Range
Dim rngRowZero As Range
Dim rngRowOne As Range
Dim SERIESWIDTH As Integer
Dim lCol As Long
Dim lRow As Long
Dim lRow2 As Long
Dim i As Long
'Const SERIESAROW As Long = 32, SERIESBROW As Long = 33, SERIESCROW As Long = 34, SERIESDROW As Long = 35, SERIESEROW As Long = 36, SERIESFROW As Long = 37,
'Const SERIESWIDTH As Long = 5
'Const SERIESARANGE As String = "$D$32", SERIESBRANGE As String = "$D$33", SERIESCRANGE As String = "$D$34", SERIESDRANGE As String = "$D$35", SERIESERANGE As String = "$D$36", SERIESFRANGE As String = "$D$37"
Const XVALUESROW As Long = 2
'Const ERRORAROW As Long = 39, ERRORBROW As Long = 40, ERRORCROW As Long = 41, ERRORDROW As Long = 42, ERROREROW As Long = 43, ERRORFROW As Long = 44
'Allow user to choose the column / cell containing the "0" data in, so that the appropriate range can be selected
'If the user cancels the InputBox then an error will be generated, hence error handling is temporarily disabled
On Error Resume Next 'Error handling disabled
Set rngColumnZero = Application.InputBox(Prompt:="Please select first data column", Title:="Graph maker", Type:=8)
If rngColumnZero Is Nothing Then Exit Sub 'If user presses cancel this will be true, so exit routine
On Error GoTo 0 'Error handling re-enabled
lCol = rngColumnZero.Column 'Store the numerical column reference as a variable to use
'Test Code 1
On Error Resume Next 'Error handling disabled
Set rngRowZero = Application.InputBox(Prompt:="Please select first data row", Title:="Graph maker", Type:=8)
If rngRowZero Is Nothing Then Exit Sub 'If user presses cancel this will be true, so exit routine
On Error GoTo 0 'Error handling re-enabled
lRow = rngRowZero.Row 'Store the numerical row reference as a variable to use
'Test Code 2
On Error Resume Next 'Error handling disabled
Set rngRowOne = Application.InputBox(Prompt:="Please select first error row", Title:="Graph maker", Type:=8)
If rngRowOne Is Nothing Then Exit Sub 'If user presses cancel this will be true, so exit routine
On Error GoTo 0 'Error handling re-enabled
lRow2 = rngRowOne.Row 'Store the numerical row reference as a variable to use
'Test Code 3
On Error Resume Next 'Error handling disabled
SERIESWIDTH = Application.InputBox(Prompt:="Please ender number of columns", Title:="Graph maker", Type:=1) - 1
On Error GoTo 0 'Error handling re-enabled
'Create new chart as object for later manipulation
Set chtNew = ActiveSheet.Shapes.AddChart(xlLineMarkers).Chart
With chtNew
'Delete all auto added series which might get added if Excel tries to 'guess' the layout of your data
For i = .SeriesCollection.Count To 1 Step -1
.SeriesCollection(i).Delete
Next i
'Add both series
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = ActiveSheet.Range("D" & lRow)
.SeriesCollection(1).Values = ActiveSheet.Range(ActiveSheet.Cells(lRow, lCol), ActiveSheet.Cells(lRow, lCol + SERIESWIDTH))
.SeriesCollection(1).XValues = ActiveSheet.Range(ActiveSheet.Cells(XVALUESROW, lCol), ActiveSheet.Cells(XVALUESROW, lCol + SERIESWIDTH))
.SeriesCollection.NewSeries
.SeriesCollection(2).Name = ActiveSheet.Range("D" & lRow + 1)
.SeriesCollection(2).Values = ActiveSheet.Range(ActiveSheet.Cells(lRow + 1, lCol), ActiveSheet.Cells(lRow + 1, lCol + SERIESWIDTH))
.SeriesCollection.NewSeries
.SeriesCollection(3).Name = ActiveSheet.Range("D" & lRow + 2)
.SeriesCollection(3).Values = ActiveSheet.Range(ActiveSheet.Cells(lRow + 2, lCol), ActiveSheet.Cells(lRow + 2, lCol + SERIESWIDTH))
.SeriesCollection.NewSeries
.SeriesCollection(4).Name = ActiveSheet.Range("D" & lRow + 3)
.SeriesCollection(4).Values = ActiveSheet.Range(ActiveSheet.Cells(lRow + 3, lCol), ActiveSheet.Cells(lRow + 3, lCol + SERIESWIDTH))
.SeriesCollection.NewSeries
.SeriesCollection(5).Name = ActiveSheet.Range("D" & lRow + 4)
.SeriesCollection(5).Values = ActiveSheet.Range(ActiveSheet.Cells(lRow + 4, lCol), ActiveSheet.Cells(lRow + 4, lCol + SERIESWIDTH))
.SeriesCollection.NewSeries
.SeriesCollection(6).Name = ActiveSheet.Range("D" & lRow + 5)
.SeriesCollection(6).Values = ActiveSheet.Range(ActiveSheet.Cells(lRow + 5, lCol), ActiveSheet.Cells(lRow + 5, lCol + SERIESWIDTH))
'Put legend at top
.SetElement (msoElementLegendTop)
'Tidy up gridlines and set y axis spacing
.Axes(xlValue).MajorGridlines.Delete
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue).MaximumScale = 60
.Axes(xlValue).MajorUnit = 10
.Axes(xlValue).TickLabels.NumberFormat = "0"
'Set axis font size
.Axes(xlCategory).TickLabels.Font.Size = 12
.Axes(xlValue).TickLabels.Font.Size = 12
'Resize chart overall
.Parent.Height = 320
.Parent.Width = 250
'Resize plot area within chart
.PlotArea.Height = 250
.PlotArea.Top = 40
.PlotArea.Width = 220
.PlotArea.Left = 7
''''Series markers / lines
'Triangle style (3) marker size 7
.SeriesCollection(1).MarkerStyle = 3
.SeriesCollection(1).MarkerSize = 7
.SeriesCollection(1).MarkerBackgroundColor = RGB(0, 102, 0)
.SeriesCollection(1).MarkerForegroundColor = RGB(0, 102, 0)
.SeriesCollection(1).Format.Line.Weight = 1
.SeriesCollection(2).MarkerStyle = 3
.SeriesCollection(2).MarkerSize = 7
.SeriesCollection(2).MarkerBackgroundColor = RGB(204, 255, 204)
.SeriesCollection(2).MarkerForegroundColor = RGB(204, 255, 204)
.SeriesCollection(2).Format.Line.Weight = 1
.SeriesCollection(3).MarkerStyle = 3
.SeriesCollection(3).MarkerSize = 7
.SeriesCollection(3).Format.Line.Weight = 1
.SeriesCollection(3).MarkerBackgroundColor = RGB(0, 0, 0)
.SeriesCollection(3).MarkerForegroundColor = RGB(0, 0, 0)
.SeriesCollection(4).MarkerStyle = 3
.SeriesCollection(4).MarkerSize = 7
.SeriesCollection(4).Format.Line.Weight = 1
.SeriesCollection(4).MarkerBackgroundColor = RGB(192, 192, 192)
.SeriesCollection(4).MarkerForegroundColor = RGB(192, 192, 192)
.SeriesCollection(5).MarkerStyle = 3
.SeriesCollection(5).MarkerSize = 7
.SeriesCollection(5).Format.Line.Weight = 1
.SeriesCollection(5).MarkerBackgroundColor = RGB(255, 0, 0)
.SeriesCollection(5).MarkerForegroundColor = RGB(255, 0, 0)
.SeriesCollection(6).MarkerStyle = 3
.SeriesCollection(6).MarkerSize = 7
.SeriesCollection(6).Format.Line.Weight = 1
.SeriesCollection(6).MarkerBackgroundColor = RGB(255, 229, 204)
.SeriesCollection(6).MarkerForegroundColor = RGB(255, 229, 204)
End With
'Format line as black for each series
For i = 1 To 6
With chtNew.SeriesCollection(i).Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
End With
Next i
With chtNew
'Legend text size
.Legend.Format.TextFrame2.TextRange.Font.Size = 10.9
'Move legend
.Legend.Left = 58
.Legend.Top = 47
.Legend.Width = 144
'Error bars pass as R1C1 references! Doesn't seem to like standard range addresses. See http://peltiertech.com/WordPress/custom-error-bars-in-excel-charts/#more-3221 for details
.SeriesCollection(1).ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, _
Amount:="'" & ActiveSheet.Name & "'!R" & lRow2 & "C" & lCol & ":R" & lRow2 & "C" & lCol + SERIESWIDTH, _
MinusValues:="'" & ActiveSheet.Name & "'!R" & lRow2 & "C" & lCol & ":R" & lRow2 & "C" & lCol + SERIESWIDTH
'Second series
.SeriesCollection(2).ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, _
Amount:="'" & ActiveSheet.Name & "'!R" & lRow2 + 1 & "C" & lCol & ":R" & lRow2 + 1 & "C" & lCol + SERIESWIDTH, _
MinusValues:="'" & ActiveSheet.Name & "'!R" & lRow2 + 1 & "C" & lCol & ":R" & lRow2 + 1 & "C" & lCol + SERIESWIDTH
'Third series
.SeriesCollection(3).ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, _
Amount:="'" & ActiveSheet.Name & "'!R" & lRow2 + 2 & "C" & lCol & ":R" & lRow2 + 2 & "C" & lCol + SERIESWIDTH, _
MinusValues:="'" & ActiveSheet.Name & "'!R" & lRow2 + 2 & "C" & lCol & ":R" & lRow2 + 2 & "C" & lCol + SERIESWIDTH
'Forth series
.SeriesCollection(4).ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, _
Amount:="'" & ActiveSheet.Name & "'!R" & lRow2 + 3 & "C" & lCol & ":R" & lRow2 + 3 & "C" & lCol + SERIESWIDTH, _
MinusValues:="'" & ActiveSheet.Name & "'!R" & lRow2 + 3 & "C" & lCol & ":R" & lRow2 + 3 & "C" & lCol + SERIESWIDTH
'Fifth series
.SeriesCollection(5).ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, _
Amount:="'" & ActiveSheet.Name & "'!R" & lRow2 + 4 & "C" & lCol & ":R" & lRow2 + 4 & "C" & lCol + SERIESWIDTH, _
MinusValues:="'" & ActiveSheet.Name & "'!R" & lRow2 + 4 & "C" & lCol & ":R" & lRow2 + 4 & "C" & lCol + SERIESWIDTH
'Sixth series
.SeriesCollection(6).ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, _
Amount:="'" & ActiveSheet.Name & "'!R" & lRow2 + 5 & "C" & lCol & ":R" & lRow2 + 5 & "C" & lCol + SERIESWIDTH, _
MinusValues:="'" & ActiveSheet.Name & "'!R" & lRow2 + 5 & "C" & lCol & ":R" & lRow2 + 5 & "C" & lCol + SERIESWIDTH
'Chart Lables
.HasTitle = True
.ChartTitle.Text = ActiveSheet.Range(ActiveSheet.Cells(1, lCol), ActiveSheet.Cells(1, lCol + 0))
'X axis name
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "X-axis Title"
'Y-axis name
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Y-axis Title"
End With
End Sub