Public Function GetRange(box_message As String) As Range
Set GetRange = Nothing
On Error Resume Next
Set GetRange = Application.InputBox(box_message, "Select Range", Selection.Address, , , , , 8)
End Function

Public Function IsNotOk(ByVal rng As Range) As Boolean 'TO CHECK IF A GIVEN RANGE IS BLANK
IsNotOk = True
On Error GoTo if_error_occured:
If rng.Rows.Count > 0 And rng.Columns.Count = 1 Then IsNotOk = False
if_error_occured:
If Err.Number Then IsNotOk = True
End Function

Public Function check_if_numeric(rng As Range) As Boolean
Dim cel As Range
check_if_numeric = True
For Each cel In rng.Cells
If Not (Application.WorksheetFunction.IsNumber(cel.Value)) Then check_if_numeric = False
Next cel
End Function

Sub make_control_chart()
Dim data_values As Range
Dim chart_labels As Range
Dim range_selected_before As Range
Dim got_label_range As Boolean
Dim got_value_range As Boolean
Dim bActivate As Boolean
Dim myChtObj As ChartObject
Dim plot_series, MyNewSrs As Series
Dim series_label As String
Dim number_of_control_limits As Integer
Dim standard_deviation As Integer
Dim data_str As String
Dim avg_str As String

On Error GoTo if_error_occured: 'GOTO THE END OF THE PROGRAM

'GET RANGE FOR DATA VALUES
bActivate = False   ' True to re-activate the input range
Set data_values = GetRange("Please select the range containing the DATA POINTS" & Chr(13) & "(press select a single column)")
If IsNotOk(data_values) Then
MsgBox "Incorrect Input Data !"
End
ElseIf Not (check_if_numeric(data_values)) Then
MsgBox "Incorrect Input Data !"
End
End If

'GET RANGE FOR CHART X-AXIS LABELS
got_label_range = True   ' True to re-activate the input range
Set chart_labels = GetRange("Please select the range containing the LABELS" & Chr(13) & "(press ESC if no labels available)")
If IsNotOk(chart_labels) Then
got_label_range = False
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'LETS CREATE THE CHART NOW
Set myChtObj = ActiveSheet.ChartObjects.Add(Left:=100, Width:=400, Top:=25, Height:=300)
myChtObj.Chart.ChartType = xlLineMarkers

'REMOVE ALL UNWANTED SERIES FROM CHART, IF ANY
For Each MyNewSrs In myChtObj.Chart.SeriesCollection ' myChtObj.Chart.SeriesCollection
MyNewSrs.Delete
Next MyNewSrs
Set MyNewSrs = Nothing

If got_label_range Then 'IF WE HAVE THE LABEL RANGE
'ADD NEW SERIES
Set MyNewSrs = myChtObj.Chart.SeriesCollection.NewSeries
With MyNewSrs
.Name = "PLOT"
.Values = data_values
.XValues = chart_labels
End With
Else
Set MyNewSrs = myChtObj.Chart.SeriesCollection.NewSeries
With MyNewSrs
.Name = "PLOT"
.Values = data_values
End With
End If

'FORMAT THE PLOT SERIES
Set plot_series = MyNewSrs
With MyNewSrs
.Border.ColorIndex = 1
.MarkerBackgroundColorIndex = 2
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlCircle
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
Set MyNewSrs = Nothing

'CREATE NAMED RANGE FOR THE DATA VALUES, AVERAGE, LOWER AND UPPER CONTROL LIMITS
data_str = Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_data_values"
avg_str = "roundup(average(" & Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_data_values" & "),2)"

ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_data_values", RefersToR1C1:=data_values
ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_AVG", RefersToR1C1:="=" & avg_str & ""
ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_LCL1", RefersToR1C1:="=" & avg_str & "- roundup(1*stdev(" & data_str & "),2)"
ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_LCL2", RefersToR1C1:="=" & avg_str & "- roundup(2*stdev(" & data_str & "),2)"
ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_LCL3", RefersToR1C1:="=" & avg_str & "- roundup(3*stdev(" & data_str & "),2)"
ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_UCL1", RefersToR1C1:="=" & avg_str & "+ roundup(1*stdev(" & data_str & "),2)"
ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_UCL2", RefersToR1C1:="=" & avg_str & "+ roundup(2*stdev(" & data_str & "),2)"
ActiveWorkbook.Names.Add Name:=Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_UCL3", RefersToR1C1:="=" & avg_str & "+ roundup(3*stdev(" & data_str & "),2)"

'ADD THE LINE FOR AVERAGE
Set MyNewSrs = myChtObj.Chart.SeriesCollection.NewSeries

With MyNewSrs
.Name = "AVG = "
.Values = "='" & ActiveSheet.Name & "'!" & Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_AVG"
.ChartType = xlXYScatter
'.ErrorBar Direction:=xlX, Include:=xlNone, Type:=xlFixedValue, Amount:=10000
'.ErrorBar Direction:=xlX, Include:=xlUp, Type:=xlFixedValue, Amount:=20
.ErrorBar Direction:=xlX, Include:=xlPlusValues, Type:=xlFixedValue, Amount:=data_values.Rows.Count
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
With .Border
.Weight = xlHairline
.LineStyle = xlNone
End With
'With .ErrorBars.Border
'    .LineStyle = xlContinuous
'    .ColorIndex = 3
'    .Weight = xlThin
'End With
End With

Set MyNewSrs = Nothing

'ADD UPPER AND LOWER CONTROL LIMITS
For number_of_control_limits = 1 To 3
For standard_deviation = -1 To 1 Step 2

Select Case standard_deviation:
Case -1: series_label = "LCL"
Case 1: series_label = "UCL"
End Select

Set MyNewSrs = myChtObj.Chart.SeriesCollection.NewSeries
With MyNewSrs
.Name = series_label & number_of_control_limits & " ="
.Values = "='" & ActiveSheet.Name & "'!" & Application.WorksheetFunction.Substitute(myChtObj.Name, " ", "") & "_" & series_label & number_of_control_limits
.ChartType = xlXYScatter
.ErrorBar Direction:=xlX, Include:=xlPlusValues, Type:=xlFixedValue, Amount:=data_values.Rows.Count
End With

MyNewSrs.ErrorBar Direction:=xlX, Include:=xlPlusValues, Type:=xlFixedValue, Amount:=data_values.Rows.Count

Select Case number_of_control_limits:
Case 1:
With MyNewSrs.ErrorBars.Border
.LineStyle = xlGray25
.ColorIndex = 15
.Weight = xlHairline
End With
Case 2:
With MyNewSrs.ErrorBars.Border
.LineStyle = xlGray25
.ColorIndex = 57
.Weight = xlHairline
End With
Case 3:
With MyNewSrs.ErrorBars.Border
.LineStyle = xlGray75
.ColorIndex = 3
.Weight = xlHairline
End With
End Select

MyNewSrs.ErrorBars.EndStyle = xlNoCap

With MyNewSrs
With .Border
.Weight = xlHairline
.LineStyle = xlNone
End With
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
Set MyNewSrs = Nothing
Next standard_deviation
Next number_of_control_limits

myChtObj.Chart.ApplyDataLabels AutoText:=True, LegendKey:=False, _
HasLeaderLines:=False, ShowSeriesName:=True, ShowCategoryName:=False, _
ShowValue:=True, ShowPercentage:=False, ShowBubbleSize:=False, Separator:=" "

'OFFSET THE LABELS
For Each MyNewSrs In myChtObj.Chart.SeriesCollection
With MyNewSrs.Points(1).DataLabel
.Left = 400
End With
Next MyNewSrs

'LETS FORMAT THE CHART
With myChtObj
With .Chart.Axes(xlCategory)
.MajorTickMark = xlNone
.MinorTickMark = xlNone
.TickLabelPosition = xlNextToAxis
End With
With .Chart.Axes(xlValue)
.MajorTickMark = xlOutside
.MinorTickMark = xlNone
.TickLabelPosition = xlNextToAxis
End With
With .Chart.ChartArea.Border
.Weight = 1
.LineStyle = 0
End With
With .Chart.PlotArea.Border
.ColorIndex = 1
.Weight = xlThin
.LineStyle = xlContinuous
End With
With .Chart.PlotArea.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With
With .Chart.ChartArea.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
With .Chart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = True
.HasTitle = True
.ChartTitle.Characters.Text = "Control Chart"
.ChartTitle.Left = 134
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Observations"
End With
With .Chart.Axes(xlCategory).TickLabels
.Alignment = xlCenter
.Offset = 100
.ReadingOrder = xlContext
.Orientation = xlHorizontal
End With
End With

myChtObj.Chart.Legend.Delete
myChtObj.Chart.PlotArea.Width = 310
myChtObj.Chart.Axes(xlValue).MajorGridlines.Delete
myChtObj.Chart.Axes(xlValue).CrossesAt = myChtObj.Chart.Axes(xlValue).MinimumScale
myChtObj.Chart.ChartArea.Interior.ColorIndex = xlAutomatic
myChtObj.Chart.ChartArea.AutoScaleFont = True

'DELETE THE LABELS FOR THE ACTUAL DATA SERIES
plot_series.DataLabels.Delete
Set plot_series = Nothing

if_error_occured:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
If Err.Number Then z_delete_all_named_range

End Sub

Sub z_delete_all_named_range()
Dim nam As Name
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
For Each nam In ActiveWorkbook.Names
nam.Delete
Next nam
End Sub