Option Explicit
Sub CreateNewChart()
Dim chtNew As Chart
Dim rngColumnZero As Range
Dim lCol As Long
Dim i As Long
Const SERIESAROW As Long = 12, SERIESBROW As Long = 13, SERIESWIDTH As Long = 5
Const SERIESARANGE As String = "$D$12", SERIESBRANGE As String = "$D$13"
Const XVALUESROW As Long = 2
Const ERRORAROW As Long = 15, ERRORBROW As Long = 16
'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 column with 0 in", 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
'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(SERIESARANGE)
.SeriesCollection(1).Values = ActiveSheet.Range(ActiveSheet.Cells(SERIESAROW, lCol), ActiveSheet.Cells(SERIESAROW, lCol + SERIESWIDTH))
.SeriesCollection(1).XValues = ActiveSheet.Range(ActiveSheet.Cells(XVALUESROW, lCol), ActiveSheet.Cells(XVALUESROW, lCol + SERIESWIDTH))
.SeriesCollection.NewSeries
.SeriesCollection(2).Name = ActiveSheet.Range(SERIESBRANGE)
.SeriesCollection(2).Values = ActiveSheet.Range(ActiveSheet.Cells(SERIESBROW, lCol), ActiveSheet.Cells(SERIESBROW, 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 = 350
.Parent.Width = 250
'Resize plot area within chart
.PlotArea.Height = 250
.PlotArea.Top = 47
.PlotArea.Width = 215
.PlotArea.Left = 7
''''Series markers / lines
'Triangle style (3) marker size 7
.SeriesCollection(1).MarkerStyle = 3
.SeriesCollection(1).MarkerSize = 7
.SeriesCollection(2).MarkerStyle = 3
.SeriesCollection(2).MarkerSize = 7
End With
'Format line as black for each series
For i = 1 To 2
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" & ERRORAROW & "C" & lCol & ":R" & ERRORAROW & "C" & lCol + SERIESWIDTH, _
MinusValues:=ActiveSheet.Name & "!R" & ERRORAROW & "C" & lCol & ":R" & ERRORAROW & "C" & lCol + SERIESWIDTH
'Second series
.SeriesCollection(2).ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, _
Amount:=ActiveSheet.Name & "!R" & ERRORBROW & "C" & lCol & ":R" & ERRORBROW & "C" & lCol + SERIESWIDTH, _
MinusValues:=ActiveSheet.Name & "!R" & ERRORBROW & "C" & lCol & ":R" & ERRORBROW & "C" & lCol + SERIESWIDTH
End With
End Sub
