Sub bellcurve()
[a:f].ClearContents
Dim m As Integer, n As Integer, dt()
n = 6
'specify data to be used
ReDim dt(1 To n)
dt(1) = 900: dt(2) = 920: dt(3) = 933
dt(4) = 890: dt(5) = 1010: dt(6) = 1000
'calculate mean and standard deviation
For j = 1 To n
mean = mean + dt(j): std = std + dt(j) ^ 2
Next j
mean = mean / n
std = ((std - n * mean ^ 2) / (n - 1)) ^ 0.5
[e1] = Format(mean, "0.00")
[e2] = Format(std, "0.00")
'generate normal curve with average and standard deviation which are ...
'...the same as for the specified data
m = 26
[a2] = mean - 3 * std: [a3] = mean - 2.75 * std
[a2:a3].AutoFill Range("A2:A" & m), xlFillSeries
Range("A2:A" & m).NumberFormat = "0"
Range("B2:B" & m).NumberFormat = "0.0000"
For i = 2 To m
x = Cells(i, 1).Value
Cells(i, 2) = 0.39894 * Exp(-0.5 * ((x - mean) ^ 2) / (std ^ 2)) / std
Next i
Cells(m + 1, 1).Resize(n, 1) = Application.Transpose(dt)
Cells(m + 1, 3).Resize(n, 1) = 0.0001
Cells(m + 1, 1).Resize(n, 3).Font.ColorIndex = 3
Cells(m + 1, 1).Resize(n, 1).Font.Bold = True
[b1] = "Freq": [c1] = "Data marker"
[f1] = "Data Average": [f2] = "Data StDev"
'Charting
Charts.Add
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A1:C" & (n + m))
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
With ActiveChart.Axes(xlCategory)
.MinimumScale = mean - 3.5 * std
.MaximumScale = mean + 3.5 * std
End With
With ActiveChart.Legend.LegendEntries(2).LegendKey.Border
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveChart.Legend.LegendEntries(2).LegendKey
.MarkerBackgroundColorIndex = 3
.MarkerSize = 5
End With
Sheets("Sheet1").[a1].Select
End Sub