VBA Macro to run linear regression between two variables,VBA Teacher Sourav,Kolkata 08910141720

I have observations for two variable ,the column speed is for X variable,The column distance is for Y variable

Now I have Data Analysis toolpack installed,so this macro will calculate linear regression for X and Y

Sub automatelinearregression()
Sheets("Sheet1").Select

lrA = Cells(Rows.Count, "A").End(xlUp).Row
MsgBox (lrA)

lrC = Cells(Rows.Count, "B").End(xlUp).Row
MsgBox (lrC)
lr = Application.Max(lrA, lrC)  'or Min? I expect the x and y have to have the same number of values?
MsgBox (lr)
Application.Run "ATPVBAEN.XLAM!Regress", ActiveSheet.Range("B1:B" & lr), ActiveSheet.Range("A1:A" & lr), False, True, 95, ActiveSheet.Range("$O$5"), False, False, False, False, , False
End Sub

Result:

Source:http://www.vbaexpress.com/forum/showthread.php?55218-VBA-to-run-a-Linear-Regression-Automatically

Using Spin Button to increase or decrease date in VBA

Private Sub SpinButton1_SpinDown()

Dim datevar As Date
If Me.TextBox1.Text <> "" Then
On Error Resume Next
 datevar = DateValue(Me.TextBox1.Text)
 Else
 datevar = Date
 End If
 Me.TextBox1.Text = (datevar - 1)

End Sub

Private Sub SpinButton1_SpinUp()
If Me.TextBox1.Text <> "" Then
On Error Resume Next
 datevar = DateValue(Me.TextBox1.Text)
 Else
 datevar = Date
 End If
 Me.TextBox1.Text = (datevar + 1)
End Sub

Automating Print preview of excel reports using vba

'this is for setting the center header of print which will print as Active Employee List
ersheet.PageSetup.CenterHeader = "Active Employee List"
'this is for setting the right footer of print which will print as Page (number of current page) of Total Pages
ersheet.PageSetup.RightFooter = "Page &P of &N"

'this commented out section works best with portrait printing
'ersheet.PageSetup.Zoom = 60
'ersheet.PageSetup.FitToPagesWide = 1

'ersheet.PageSetup.FitToPagesTall = False

'this section works best for landscape printing
With ersheet.PageSetup
'for setting portrait or landscape
.Orientation = xlLandscape
'these next two line will fit all columns in one page
.FitToPagesWide = 1
.FitToPagesTall = 1
'this line is responsible for continuing one fixed row on several print pages ,it is similar as excel freeze pane
.PrintTitleRows = ersheet.Rows(1).Address
End With

ersheet.PrintPreview

Output

Source:

https://docs.softartisans.com/officewriterwindows/3.0.5/ExcelWriterASP/features/headersandfooters.aspx

https://stackoverflow.com/questions/34052790/vba-code-to-set-print-area-fit-to-1x1-page-and-not-set-print-area-for-certain-t

https://www.youtube.com/watch?v=X4QBS94iNdo&list=PLw8O1w0Hv2zvnLFyiMrihcaOqA0sT0X2U&index=13

Creating Moving Average chart automatically based on 4 series collection(Moving Averages,UCL,CL,LCL) using Excel VBA ,VBA Teacher Sourav,Kolkata 08910141720

Sub movingrangechartmacro()

Dim co As ChartObject
    Dim ct As Chart
    Dim scl As SeriesCollection
    Dim ser1 As Series
    Dim chartname As String

    Sheets("MovingRange").Select

       Set co = Worksheets("MovingRange").ChartObjects.Add(Range("H8").Left, Range("H8").Top, 2500, 500)
       
       'chartname = Worksheets("process_capability").Range("D15").Value
       chartname = "movingrange"
       co.Name = chartname
      ' MsgBox (co.Name)
       Set ct = co.Chart
       With ct
       .HasLegend = True
       .HasTitle = True
       .ChartTitle.Text = "Moving Range Chart"
       Set sc1 = .SeriesCollection
       Set ser1 = sc1.NewSeries
       With ser1
       .Name = Worksheets("MovingRange").Range("B1").Value
       .xvalues = Range(Worksheets("MovingRange").Range("A1").Offset(1, 0), Worksheets("MovingRange").Range("A1").End(xlDown))
       .Values = Range(Worksheets("MovingRange").Range("B1").Offset(1, 0), Worksheets("MovingRange").Range("B1").End(xlDown))
       .ChartType = xlXYScatterLinesNoMarkers
       '.Select
       '.Smooth = True
        
       End With
       
       Set sc1 = .SeriesCollection
       Set ser1 = sc1.NewSeries
       With ser1
       .Name = Worksheets("MovingRange").Range("D1").Value
       .xvalues = Range(Worksheets("MovingRange").Range("A1").Offset(1, 0), Worksheets("MovingRange").Range("A1").End(xlDown))
       .Values = Range(Worksheets("MovingRange").Range("D1").Offset(1, 0), Worksheets("MovingRange").Range("D1").End(xlDown))
       .ChartType = xlXYScatterLinesNoMarkers
       '.Select
       '.Smooth = True
        
       End With
       
       Set sc1 = .SeriesCollection
       Set ser1 = sc1.NewSeries
       With ser1
       .Name = Worksheets("MovingRange").Range("E1").Value
       .xvalues = Range(Worksheets("MovingRange").Range("A1").Offset(1, 0), Worksheets("MovingRange").Range("A1").End(xlDown))
       .Values = Range(Worksheets("MovingRange").Range("E1").Offset(1, 0), Worksheets("MovingRange").Range("E1").End(xlDown))
       .ChartType = xlXYScatterLinesNoMarkers
       '.Select
       '.Smooth = True
        
       End With
       
       
       
       Set sc1 = .SeriesCollection
       Set ser1 = sc1.NewSeries
       With ser1
       .Name = Worksheets("MovingRange").Range("F1").Value
       .xvalues = Range(Worksheets("MovingRange").Range("A1").Offset(1, 0), Worksheets("MovingRange").Range("A1").End(xlDown))
       .Values = Range(Worksheets("MovingRange").Range("F1").Offset(1, 0), Worksheets("MovingRange").Range("F1").End(xlDown))
       .ChartType = xlXYScatterLinesNoMarkers
       '.Select
       '.Smooth = True
        
       End With
      
       .Axes(xlValue).MajorGridlines.Select
         Selection.Delete
         Dim high, low As Long
         
      high = Round(((Application.WorksheetFunction.max(.SeriesCollection(2).Values))), 0)
      'MsgBox (high)
         low = Round(((Application.WorksheetFunction.min(.SeriesCollection(4).Values))), 0)
      'MsgBox (low)
      .Axes(xlValue).Select
      .Axes(xlValue).MinimumScale = low
      .Axes(xlValue).MaximumScale = high
      .Axes(xlValue).MajorUnit = 0.5
      Range(Worksheets("MovingRange").Range("A1").Offset(1, 0), Worksheets("MovingRange").Range("A1").End(xlDown)).Select
    high = Round(Application.WorksheetFunction.max(Selection), 0)
    'MsgBox (high)
     low = Round(Application.WorksheetFunction.min(Selection), 0)
     .Axes(xlCategory).Select
      .Axes(xlCategory).MinimumScale = low
      .Axes(xlCategory).MaximumScale = high
      .Axes(xlCategory).MajorUnit = 1
     
     
     'X axis name
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Day Index"
'y-axis name
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Gas Use"

'coloring and designing the marker and the data series

Set sc1 = ct.SeriesCollection(1)
With sc1

    .Format.Line.Weight = 2 'Line.Weigth works ever

 .Format.Line.Visible = msoFalse 'for Line.ForeColor getting to work we have to cheat something
 .Format.Line.Visible = msoTrue
 .Format.Line.ForeColor.RGB = RGB(0, 0, 0) 'now it works

 .MarkerSize = 8
 .MarkerBackgroundColor = RGB(0, 0, 0) 'marker background

 .MarkerForegroundColor = RGB(0, 0, 0) 'marker foreground (lines around)
    
     End With
    
    
     
       
 'coloring UCL seriescollection
 Set sc1 = ct.SeriesCollection(2)
With sc1

    .Format.Line.Weight = 4 'Line.Weigth works ever

 .Format.Line.Visible = msoFalse 'for Line.ForeColor getting to work we have to cheat something
 .Format.Line.Visible = msoTrue
 .Format.Line.ForeColor.RGB = RGB(255, 0, 0) 'now it works

 '.MarkerSize = 8
 '.MarkerBackgroundColor = RGB(0, 0, 0) 'marker background

 '.MarkerForegroundColor = RGB(0, 0, 0) 'marker foreground (lines around)
    
     End With

  'coloring LCL seriescollection
 Set sc1 = ct.SeriesCollection(4)
With sc1

    .Format.Line.Weight = 4 'Line.Weigth works ever

 .Format.Line.Visible = msoFalse 'for Line.ForeColor getting to work we have to cheat something
 .Format.Line.Visible = msoTrue
 .Format.Line.ForeColor.RGB = RGB(255, 0, 0) 'now it works

 '.MarkerSize = 8
 '.MarkerBackgroundColor = RGB(0, 0, 0) 'marker background

 '.MarkerForegroundColor = RGB(0, 0, 0) 'marker foreground (lines around)
    
     End With
     
     
  'coloring CL seriescollection
 Set sc1 = ct.SeriesCollection(3)
With sc1

    .Format.Line.Weight = 4 'Line.Weigth works ever

 .Format.Line.Visible = msoFalse 'for Line.ForeColor getting to work we have to cheat something
 .Format.Line.Visible = msoTrue
 .Format.Line.ForeColor.RGB = RGB(0, 255, 0) 'now it works

 '.MarkerSize = 8
 '.MarkerBackgroundColor = RGB(0, 0, 0) 'marker background

 '.MarkerForegroundColor = RGB(0, 0, 0) 'marker foreground (lines around)
    
     End With


       
  End With
End Sub


The picture of chart to be created

The source Data

The video where the chart is created manually

https://www.youtube.com/watch?v=uGgd3iiQrUI

The link from stackoverflow which helped me regarding marker on series collection on a chart issue 

https://stackoverflow.com/questions/29675485/excel-vba-line-color-marker-line-color?answertab=votes#tab-top

Add two numbers present on sheet on User Alert using Google Apps Script

function addtwonumbersonsheet() {
 
var sh1=SpreadsheetApp.getActiveSpreadsheet();
var sheet1=sh1.getSheetByName("GAS_Sheet");
var num1=sheet1.getRange(2,1).getValue();
var num2=sheet1.getRange(2,2).getValue();  
var sh=SpreadsheetApp.getUi();
var response=sh.alert("Do you want to add the two number?",sh.ButtonSet.YES_NO);
if (response == sh.Button.YES)
{
  sheet1.getRange(2,3).setValue(num1+num2);
 
}

}

Taking input and Switch Case using Google Apps Script

//Declaring variables
var ui = SpreadsheetApp.getUi();
// Get the value from the user
var get_text= ui.prompt("Enter any number from 1 to 7").getResponseText();
//Convert the data type to integer
var get_num=parseInt(get_text);
//Comparing the entered number with days in a week
switch(get_num)
 {
   
   case 1:
        ui.alert("Today is sunday");
        break;   
   case 2:
        ui.alert("Today is monday");
        break;
   case 3:
        ui.alert("Today is tuesday");
        break;
   case 4:
        ui.alert("Today is Wednesday")
        break;
   case 5:
       ui.alert("Today is Thursday");
        break;
   case 6:
        ui.alert("Today is Friday");
        break;
   case 7:
        ui.alert("Today is Saturday");
        break;
   default:
         ui.alert("Entered number is not fall between 1 to 7")
 }






 

Toast Pop Up Using Google Apps Script

function greeting()
{
  SpreadsheetApp.getActiveSpreadsheet().toast("toast tester", "greeting", (number of seconds ,-1 for permanent)
 
 
 
}

Hello world using google apps script

function hello_world() {
  var my_message="hello world";
  SpreadsheetApp.getUi().alert(my_message);
}

Automating calculation of Process Capability,CP,CPK,PPM using Six Sigma using VBA ,VBA Teacher Sourav,Kolkata 08910141720

Sub process_capability_macro()


 With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

Dim lRow As Long
Dim lCol As Long
Dim area As String
Dim averageval, stddevval, upper, lower As Double


Sheets("process_capability").Select

'a little housekeeping

    Range("B16").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("D16").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("E16").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("F16").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("G16").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("H16").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
   
   'let us begin
  
   Sheets("process_capability").Select


Dim address As String
address = "C16"
  lRow = Range(address).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    area = GetText(address) & 16 & ":" & GetText(address) & lRow
    Range("C2").Select
    ActiveCell.Value = "UTL(Upper Tolerance Limit)"
    Range("B2").Select
    ActiveCell.Value = 92
    Range("C3").Select
    ActiveCell.Value = "LTL(Lower Tolerance Limit)"
   Range("B3").Select
    ActiveCell.Value = 89.5
    Range("C4").Select
     ActiveCell.Value = "µ(Arithmatic Mean)"
        averageval = Application.WorksheetFunction.average(Range(area))
       Range("B4").Select
       ActiveCell.Value = averageval
       Range("C5").Select
       ActiveCell.Value = "(StandardDeviation Of A Sample)"

       Range("B5").Select
      
      ' ActiveCell.Formula = "=FIND(""$""," & """" & s & """" & ")"
       
      ' ActiveCell.Formula = "=STDEVA(" & (area) & ") "
    ' ActiveCell.Formula = "=STDEVA( " & area & ")"
   
     ActiveCell.Formula = "=STDEVA(" & Range(area).address & ")"
    
     stddevval = ActiveCell.Value
    
     Range("C6").Select
       ActiveCell.Value = "Upper Six-Sigma-Limit"
        Range("B6").Select
        ActiveCell.Value = averageval + (6 * stddevval)
     
       
       
      Range("C7").Select
       ActiveCell.Value = "Lower Six-Sigma-Limit"
        Range("B7").Select
        ActiveCell.Value = averageval - (6 * stddevval)
        lower = averageval - (6 * stddevval)
       Range("B15").Select
       ActiveCell.Value = "Bins"
       ActiveCell.Offset(1, 0).Select
      
     
      ' MsgBox (lower)
       Dim temp As Double
       temp = (averageval - (6 * stddevval)) - 1
      While temp < ((averageval + (6 * stddevval)) + 1)
     
       ActiveCell.Value = Round(temp, 2)
       temp = temp + 0.01
       ActiveCell.Offset(1, 0).Select
       Wend
        Range("D15").Select
       ActiveCell.Value = "Frequency"
       '
      
      
       Dim lRow1 As Long
       Dim lRow2 As Long
      
       address = "C16"
      lRow1 = Range(address).End(xlDown).Row
      address = "B16"
      lRow2 = Range(address).End(xlDown).Row
    area = "D16:D" & lRow2
    Range(area).Select
       Selection.FormulaArray = "=FREQUENCY(RC[-1]:R" & (lRow1) & "C[-1],RC[-2]:R" & (lRow2) & "C[-2])"
      
       'creating new sheet
      
        Dim newSheetName As String
    Dim checkSheetName As String
    'newSheetName = Application.InputBox("Input Sheet Name:", "Kutools for Excel", _
                                    "sheet4", , , , , 2)
    newSheetName = "Chart"
                                   
    On Error Resume Next
    checkSheetName = Worksheets(newSheetName).Name
    If checkSheetName = "" Then
       ' Worksheets.Add.Name = newSheetName
       ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = newSheetName
        
    Else
   
    Worksheets(newSheetName).Delete
   
         ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = newSheetName
    End If
    'Creating the 2d column chart otherwise known as column clustered chart
   
'    Dim co As ChartObject
'    Dim ct As Chart
'    Dim scl As SeriesCollection
'    Dim ser1 As Series
'    Dim chartname As String
'
'    Sheets("process_capability").Select
'
'       Set co = Worksheets("process_capability").ChartObjects.Add(Range("P2").Left, Range("P2").Top, 700, 300)
'       chartname = Worksheets("process_capability").Range("D15").Value
'       co.Name = chartname
'      ' MsgBox (co.Name)
'       Set ct = co.Chart
'       With ct
'       .HasLegend = True
'       .HasTitle = True
'       .ChartTitle.Text = "Frequency"
'       Set sc1 = .SeriesCollection
'       Set ser1 = sc1.NewSeries
'       With ser1
'       .Name = Range("D15").Value
'       .XValues = Range(Range("B15").Offset(1, 0), Range("B15").End(xlDown))
'       .Values = Range(Range("D15").Offset(1, 0), Range("D15").End(xlDown))
'       .ChartType = xlColumnClustered
'
'       End With
'
'
'       End With
      
'create 2d frequency chart

Call createfrequencychart

'Probability mass function calculation

Sheets("process_capability").Select

Range("E15").Select
       ActiveCell.Value = "Probability Mass Function"
       '
      

      
       address = "B16"
      lRow1 = Range(address).End(xlDown).Row
      'MsgBox (lRow1)
     
    area = "E16:E" & lRow1
    Range(area).Select
        Selection.FormulaArray = "=NORM.DIST(RC[-3]:R" & (lRow1) & "C[-3],R[-12]C[-3],R[-11]C[-3],FALSE)"

'now we have add the probability mass function data with respect to beans in our chart

Call modchart

'Cumulative distribution function

 'Range("F16:F35").Select
  '  Selection.FormulaArray = "=NORM.DIST(RC[-4]:R[19]C[-4],R[-12]C[-4],R[-11]C[-4],TRUE)"
  Sheets("process_capability").Select

Range("F15").Select
       ActiveCell.Value = "Cumulative Distribution Function"
       '
      

      
       address = "B16"
      lRow1 = Range(address).End(xlDown).Row
      'MsgBox (lRow1)
     
    area = "F16:F" & lRow1
    Range(area).Select
        Selection.FormulaArray = "=NORM.DIST(RC[-4]:R" & (lRow1) & "C[-4],R[-12]C[-4],R[-11]C[-4],TRUE)"
        'Selection.FormulaArray = "=NORM.DIST(RC[-4]:R[19]C[-4],R[-12]C[-4],R[-11]C[-4],TRUE)"


'Let us add an second chart on cumulative distribution function on Chart sheet which will be a line chart
Call secondchart

'Maximum vertical axis or maximum frequency value

Sheets("process_capability").Select

Dim maximum As Double

 address = "D16"


 lRow = Range("D16").End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    area = GetText(address) & 16 & ":" & GetText(address) & lRow
   
    maximum = Application.max(Range(area))
    Range("C8").Select
    ActiveCell.Value = "Maximum Vertical Axis"
   
    Range("B8").Select
    ActiveCell.Value = maximum
   
'Six sigma limits
Sheets("process_capability").Select
 Range("G15").Select
    ActiveCell.FormulaR1C1 = "Six Sigma Limits"
   
    address = "G16"


 lRow = Range("B16").End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    area = GetText(address) & 16 & ":" & GetText(address) & lRow
    'MsgBox (area)
    Range("G16").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-5]=ROUND(R6C2,2),R8C2,IF(RC[-5]=ROUND(R7C2,2),R8C2,0))"
    Range("G16").Select
    Selection.AutoFill Destination:=Range(area)
   
    'sig sigma limits should be incorporated in our first chart
   
    Call modchart2
   
   
    'Tolerance Limits
   
    Sheets("process_capability").Select
 Range("H15").Select
    ActiveCell.FormulaR1C1 = "Tolerance Limits"
   
    address = "H16"


 lRow = Range("B16").End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    area = GetText(address) & 16 & ":" & GetText(address) & lRow
    'MsgBox (area)
    Range("H16").Select
    'ActiveCell.FormulaR1C1 = "=IF(RC[-6]=ROUND(R6C2,2),R8C2,IF(RC[-5]=ROUND(R7C2,2),R8C2,0))"
     ActiveCell.FormulaR1C1 = "=IF(RC[-6]=ROUND(R2C2,2),R8C2,IF(RC[-6]=ROUND(R3C2,2),R8C2,0))"
    Range("H16").Select
    Selection.AutoFill Destination:=Range(area)
    'Tolerance limits should be incorporated in our first chart
    Call modchart3
   
    'last calculations
    Sheets("process_capability").Select
   
     lRow = Range("B16").End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
   ' MsgBox (lRow)
   
      Range("C9").Select
    ActiveCell.FormulaR1C1 = "CPK(Process Capability Index)"
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "CP(Maximum Possible Process Capability)"
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "Parts within the tolerance limits in one million manufactured parts"
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "PPM(parts outside the tolerance limits in one million manufactured parts )"
    ActiveCell.Offset(-3, -1).Select
    ActiveCell.FormulaR1C1 = "=MIN(R[-7]C-R[-5]C,R[-5]C-R[-6]C)/(3*R[-4]C)"
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=(R[-8]C-R[-7]C)/(6*R[-5]C)"
    ActiveCell.Offset(1, 0).Select
 
    address = Replace(ActiveCell.address, "$", "")
    'Dim LArray() As String
   ' LArray = Split(address, ":")
    'MsgBox (LArray(1))


   
  
    Dim cellnum As Range
    Set cellnum = ActiveCell
      Dim firstval As Double
  Dim secondval As Double
 
  cellnum.Formula = "=VLOOKUP(" & Range("B2").Value & ", 'process_capability'!B16:F" & lRow & ", 5, FALSE)"

  firstval = ActiveCell.Value
  cellnum.Formula = "=VLOOKUP(" & Range("B3").Value & ", 'process_capability'!B16:F" & lRow & ", 5, FALSE)"
  secondval = ActiveCell.Value
  cellnum.Value = (firstval - secondval) * 1000000
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=1000000-R[-1]C"
   
    'last makeup of charts
    Call setcharttitle
   
     With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
   
   
End Sub

Function GetText(CellRef As String)
Dim StringLength As Integer
StringLength = Len(CellRef)
For i = 1 To StringLength
If Not (IsNumeric(Mid(CellRef, i, 1))) Then Result = Result & Mid(CellRef, i, 1)
Next i
GetText = Result
End Function
Sub createfrequencychart()



Dim ch As Shape
Dim yvalues As String
Dim xvalues As String
Sheets("process_capability").Select
Dim address As String
address = "D16"
  lRow = Range(address).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    yvalues = GetText(address) & 16 & ":" & GetText(address) & lRow
    'MsgBox (yvalues)
   
    address = "B16"
  lRow = Range(address).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    xvalues = GetText(address) & 16 & ":" & GetText(address) & lRow
    'MsgBox (xvalues)


    Sheets("Chart").Select
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
     Set ch = ActiveSheet.Shapes(1)
    ch.Name = "Chartprocess"
   
    ch.IncrementLeft -266.25
   ch.IncrementTop -87.75
    ch.ScaleWidth 2.6625, msoFalse, msoScaleFromTopLeft
    ch.ScaleHeight 1.4531251823, msoFalse, msoScaleFromTopLeft
    ch.Select
   
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(1).Name = "=process_capability!$D$15"
   
  '  ActiveChart.FullSeriesCollection(1).Values = "=process_capability!$D$16:$D$35"
  ActiveChart.FullSeriesCollection(1).Values = "=process_capability!" & yvalues
    'ActiveChart.FullSeriesCollection(1).xvalues = "=process_capability!$B$16:$B$35"
    ActiveChart.FullSeriesCollection(1).xvalues = "=process_capability!" & xvalues
   
End Sub

Sub modchart()
Sheets("process_capability").Select
Dim yvalues As String
Dim xvalues As String

Dim address As String
address = "E16"
  lRow = Range(address).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    yvalues = GetText(address) & 16 & ":" & GetText(address) & lRow
   ' MsgBox (yvalues)
   
    address = "B16"
  lRow = Range(address).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    xvalues = GetText(address) & 16 & ":" & GetText(address) & lRow
    'MsgBox (xvalues)


Sheets("Chart").Select
Dim ch As Shape
Set ch = ActiveSheet.Shapes(1)
ch.Select


    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(2).Name = "=process_capability!$E$15"
    'ActiveChart.FullSeriesCollection(2).Values = "=process_capability!$E$16:$E$35"
    ActiveChart.FullSeriesCollection(2).Values = "=process_capability!" & yvalues
   ' ActiveChart.FullSeriesCollection(2).xvalues = "=process_capability!$B$16:$B$35"
   ActiveChart.FullSeriesCollection(2).xvalues = "=process_capability!" & xvalues
  
  
    ActiveChart.PlotArea.Select
    ActiveChart.ChartArea.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.FullSeriesCollection(1).ChartType = xlColumnClustered
   ' ActiveChart.FullSeriesCollection(1).AxisGroup = 1
    ActiveChart.FullSeriesCollection(2).ChartType = xlLine
    ActiveChart.FullSeriesCollection(1).AxisGroup = 1
 
      ActiveChart.FullSeriesCollection(2).AxisGroup = 2
    ActiveSheet.ChartObjects("Chartprocess").Activate
    ActiveChart.FullSeriesCollection(2).Select
    ActiveChart.FullSeriesCollection(2).Smooth = True
    ActiveChart.Axes(xlValue, xlSecondary).Select
    ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = 0
    ActiveChart.ChartArea.Select

End Sub

Sub secondchart1()
Dim co As ChartObject
    Dim ct As Chart
    Dim scl As SeriesCollection
    Dim ser1 As Series
    Dim chartname As String

    Sheets("Chart").Select

       Set co = Worksheets("Chart").ChartObjects.Add(Range("D30").Left, Range("D30").Top, 900, 300)
      
       'chartname = Worksheets("process_capability").Range("D15").Value
       chartname = "cumulative"
       co.Name = chartname
      ' MsgBox (co.Name)
       Set ct = co.Chart
       With ct
       .HasLegend = True
       .HasTitle = True
       .ChartTitle.Text = Worksheets("process_capability").Range("F15").Value
       Set sc1 = .SeriesCollection
       Set ser1 = sc1.NewSeries
       With ser1
       .Name = Worksheets("process_capability").Range("F15").Value
       .xvalues = Range(Worksheets("process_capability").Range("B15").Offset(1, 0), Worksheets("process_capability").Range("B15").End(xlDown))
       .Values = Range(Worksheets("process_capability").Range("F15").Offset(1, 0), Worksheets("process_capability").Range("F15").End(xlDown))
       .ChartType = xlLine
       .Select
        .Smooth = True
       
       End With
     

       End With
      
       Sheets("Chart").Range("A1").Select
      
      
      
End Sub

Sub modchart2()
Sheets("process_capability").Select
Dim yvalues As String
Dim xvalues As String

Dim address As String
address = "G16"
  lRow = Range(address).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    yvalues = GetText(address) & 16 & ":" & GetText(address) & lRow
   ' MsgBox (yvalues)
   
    address = "B16"
  lRow = Range(address).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    xvalues = GetText(address) & 16 & ":" & GetText(address) & lRow
    'MsgBox (xvalues)


Sheets("Chart").Select
Dim ch As Shape
Set ch = ActiveSheet.Shapes(1)
ch.Select


    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(3).Name = "=process_capability!$G$15"
    'ActiveChart.FullSeriesCollection(2).Values = "=process_capability!$E$16:$E$35"
    ActiveChart.FullSeriesCollection(3).Values = "=process_capability!" & yvalues
   ' ActiveChart.FullSeriesCollection(2).xvalues = "=process_capability!$B$16:$B$35"
   ActiveChart.FullSeriesCollection(3).xvalues = "=process_capability!" & xvalues
  
  
   ActiveChart.FullSeriesCollection(1).AxisGroup = 1
 
   ActiveChart.FullSeriesCollection(2).AxisGroup = 2
     
   ActiveChart.FullSeriesCollection(3).AxisGroup = 1
     
    ActiveChart.FullSeriesCollection(1).ChartType = xlColumnClustered
    ActiveChart.FullSeriesCollection(2).ChartType = xlLine
     ActiveChart.FullSeriesCollection(3).ChartType = xlColumnClustered
      ActiveChart.FullSeriesCollection(2).Smooth = True
    ActiveChart.Axes(xlValue, xlSecondary).Select
    ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = 0
  

End Sub

Sub secondchart()
Dim co As ChartObject
    Dim ct As Chart
    Dim scl As SeriesCollection
    Dim ser1 As Series
    Dim chartname As String

    Sheets("Chart").Select

       Set co = Worksheets("Chart").ChartObjects.Add(Range("D30").Left, Range("D30").Top, 900, 300)
      
       'chartname = Worksheets("process_capability").Range("D15").Value
       chartname = "cumulative"
       co.Name = chartname
      ' MsgBox (co.Name)
       Set ct = co.Chart
       With ct
       .HasLegend = True
       .HasTitle = True
       .ChartTitle.Text = Worksheets("process_capability").Range("F15").Value
       Set sc1 = .SeriesCollection
       Set ser1 = sc1.NewSeries
       With ser1
       .Name = Worksheets("process_capability").Range("F15").Value
       .xvalues = Range(Worksheets("process_capability").Range("B15").Offset(1, 0), Worksheets("process_capability").Range("B15").End(xlDown))
       .Values = Range(Worksheets("process_capability").Range("F15").Offset(1, 0), Worksheets("process_capability").Range("F15").End(xlDown))
       .ChartType = xlLine
       .Select
        .Smooth = True
       
       End With


       End With
      
       Sheets("Chart").Range("A1").Select
      
End Sub



Sub modchart3()
Sheets("process_capability").Select
Dim yvalues As String
Dim xvalues As String

Dim address As String
address = "H16"
  lRow = Range(address).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    yvalues = GetText(address) & 16 & ":" & GetText(address) & lRow
   ' MsgBox (yvalues)
   
    address = "B16"
  lRow = Range(address).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    xvalues = GetText(address) & 16 & ":" & GetText(address) & lRow
    'MsgBox (xvalues)


Sheets("Chart").Select
Dim ch As Shape
Set ch = ActiveSheet.Shapes(1)
ch.Select


    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(4).Name = "=process_capability!$H$15"
    'ActiveChart.FullSeriesCollection(2).Values = "=process_capability!$E$16:$E$35"
    ActiveChart.FullSeriesCollection(4).Values = "=process_capability!" & yvalues
   ' ActiveChart.FullSeriesCollection(2).xvalues = "=process_capability!$B$16:$B$35"
   ActiveChart.FullSeriesCollection(4).xvalues = "=process_capability!" & xvalues
  
   ActiveChart.FullSeriesCollection(1).AxisGroup = 1
 
   ActiveChart.FullSeriesCollection(2).AxisGroup = 2
     
   ActiveChart.FullSeriesCollection(3).AxisGroup = 1
  
   ActiveChart.FullSeriesCollection(4).AxisGroup = 1
     
    ActiveChart.FullSeriesCollection(1).ChartType = xlColumnClustered
    ActiveChart.FullSeriesCollection(2).ChartType = xlLine
     ActiveChart.FullSeriesCollection(3).ChartType = xlColumnClustered
      ActiveChart.FullSeriesCollection(4).ChartType = xlColumnClustered
      ActiveChart.FullSeriesCollection(2).Smooth = True
    ActiveChart.Axes(xlValue, xlSecondary).Select
    ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = 0
  
  

End Sub



Sub setcharttitle()
Sheets("Chart").Select
Dim co As ChartObject
Dim ct As Chart
Set co = ActiveSheet.ChartObjects("Chartprocess")
Set ct = co.Chart


With ct
'X axis name
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Values(mm)"
'y-axis name
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Frequency(pieces)"
'secondary axis
.Axes(xlValue, xlSecondary).HasTitle = True
.Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Probability Mass Function"

End With

Sheets("Chart").Range("A1").Select
Sheets("process_capability").Select


End Sub

Function GetNumeric(CellRef As String)
Dim StringLength As Integer
StringLength = Len(CellRef)
For i = 1 To StringLength
If IsNumeric(Mid(CellRef, i, 1)) Then Result = Result & Mid(CellRef, i, 1)
Next i
GetNumeric = Result
End Function

Getting descripting statistics on varying number of groups with varying number of rows without data analysis toolpack using VBA

Sub descriptiveanal()
'Finds the last non-blank cell in a single row or column
  With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

Dim lRow As Long
Dim lCol As Long
Dim ColumnLetter As String
Dim area As String
Dim pasteloc As String

Sheets("descr").Select

   
    'Find the last non-blank cell in column A(1)
    lRow = Cells(1, 1).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
   
   
   
    'Find the last non-blank cell in row 1
    lCol = Cells(1, 1).End(xlToRight).Column
    ColumnLetter = Split(Cells(1, lCol).address, "$")(1)
    
  
   ' MsgBox ColumnLetter & lRow
 area = "A1:" & ColumnLetter & lRow

 lCol = lCol + 2
 ColumnLetter = Split(Cells(1, lCol).address, "$")(1)
    pasteloc = ColumnLetter & 1
    'MsgBox (pasteloc)
   
    'MsgBox (area)
    Range(area).Select
   
    Application.SendKeys "{ENTER}"
    Application.Run "ATPVBAEN.XLAM!Descr", ActiveSheet.Range(" " & area & " "), ActiveSheet.Range(" " & pasteloc & " "), "C", True, True, 1, 1, 95
   

   
   
    'this is more calculation
   
    Dim uslval As Double
   Dim lslsval As Double
  
   uslval = InputBox("enter value for usl")
   lslval = InputBox("enter value for usl")
    Dim i As Integer
    i = 1
   
   Dim address As String
   address = "A1"
      Sheets("descr").Select
      Range(address).Select
   While ActiveCell.Value <> ""
  
   Range(address).Select
  
  
  

  
   'Range("A1").Select
   Dim k As Long
   Dim minimum As Double
   Dim quartile1, quartile2, quartile3 As Double
   Dim max As Double
   Dim averageval As Double
   Dim stddevval As Double
   Dim varcoef As Double
  
  
  
    k = ActiveSheet.Range(address, ActiveSheet.Range(address).End(xlDown)).Rows.Count
   
   
    lRow = Cells(1, i).End(xlDown).Row
    If lRow = 1 Then
    lRow = 2
    End If
    area = GetText(address) & 2 & ":" & GetText(address) & lRow
   ' MsgBox (area)
    minimum = Application.min(Range(area))
    'MsgBox (minimum)
    quartile1 = Application.WorksheetFunction.Quartile(Range(area), 1)
    quartile2 = Application.WorksheetFunction.Quartile(Range(area), 2)
    quartile3 = Application.WorksheetFunction.Quartile(Range(area), 3)
   
    max = Application.min(Range(area))
   
    averageval = Application.WorksheetFunction.average(Range(area))
   
    stddevval = Application.WorksheetFunction.StDev(Range(area))
   
    area = GetText(address) & (lRow + 2)
   ' MsgBox (area)
   
   Range(area).Select
   ActiveCell.Value = "Count"
   ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = k
   ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Minimum Value"
   ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = minimum
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Quartile 1"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = quartile1
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Quartile 2"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = quartile2
  
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Quartile 3"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = quartile3
  
   ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Maximum Value"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = max
  
   ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Average"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = averageval
  
   ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Standard Deviation"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = stddevval
  
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Variation Coefficient"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = (stddevval / averageval) * 100
  
     ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "USL"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = uslval
  
     ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "LSL"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = lslval
  
   
 
  
        ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Cp"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = (uslval - lslval) / (6 * stddevval)
  
         ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Cpl"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = (averageval - lslval) / (3 * stddevval)
  
            ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Cpu"
    ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = (uslval - averageval) / (3 * stddevval)
  
               ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = "Cpk"
    ActiveCell.Offset(1, 0).Select
     Dim cpl As Double
   cpl = (averageval - lslval) / (3 * stddevval)
   Dim cpu As Double
   cpu = (uslval - averageval) / (3 * stddevval)
   ActiveCell.Value = Application.min(cpl, cpu)
  
  
   Range(address).Select
   ActiveCell.Offset(0, 1).Select
    
   address = Replace(ActiveCell.address, "$", "")
   Range(address).Select
   i = i + 1
  
    Wend
   
   
   
    ActiveSheet.Cells.Columns.AutoFit
   
   
      With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
  
End Sub

Function GetText(CellRef As String)
Dim StringLength As Integer
StringLength = Len(CellRef)
For i = 1 To StringLength
If Not (IsNumeric(Mid(CellRef, i, 1))) Then Result = Result & Mid(CellRef, i, 1)
Next i
GetText = Result
End Function

Moving Average Calculation automation using VBA,VBA Teacher Sourav,Kolkata 08910141720

Sub movingaverages()
'
' Macro4 Macro
'

'
Sheets("MovingAverages").Select

    Range("B13").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("B15").Select
    ActiveCell.FormulaR1C1 = "Data"
    Range("C13").Select
    ActiveCell.FormulaR1C1 = "mR"
    Range("C14").Select
    ActiveCell.FormulaR1C1 = "Moving"
    Range("C15").Select
    ActiveCell.FormulaR1C1 = "Range"
    Range("C17").Select
    ActiveCell.FormulaR1C1 = "=ABS(RC[-1]-R[-1]C[-1])"
    Range("C18").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-1]),"" "",ABS(RC[-1]-R[-1]C[-1]))"
    Range("C19").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-1]),"" "",ABS(RC[-1]-R[-1]C[-1]))"
    Range("C18").Select
    Selection.AutoFill Destination:=Range("C18:C216")
 
    Range("E14").Select
    ActiveCell.FormulaR1C1 = "Limits for the X Chart"
    Range("I14").Select
    ActiveCell.FormulaR1C1 = "Limit for mR Chart"
    Range("E15").Select
    ActiveCell.FormulaR1C1 = "UCL"
    Range("F15").Select
    ActiveCell.FormulaR1C1 = "X Avg"
    Range("G15").Select
    ActiveCell.FormulaR1C1 = "LCL"
    Range("H15").Select
    ActiveCell.FormulaR1C1 = "UCLmr"
    Range("I15").Select
    ActiveCell.FormulaR1C1 = "R Avg"
    Range("E16").Select
    ActiveCell.FormulaR1C1 = "=RC[1]+(RC[4]*2.66)"
    Range("E17").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-3]),"" "",R[-1]C)"
    Range("E17").Select
    Selection.AutoFill Destination:=Range("E17:E216")
  
    Range("F16").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-4]:R[200]C[-4])"
    Range("F17").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-4]),"" "",R[-1]C)"
    Range("F17").Select
    Selection.AutoFill Destination:=Range("F17:F216")
  
    Range("G16").Select
    ActiveCell.FormulaR1C1 = "=IF((RC[-1]-(RC[2]*2.66))<0 br="">    Range("G17").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-5]),"" "",R[-1]C)"
    Range("G17").Select
    Selection.AutoFill Destination:=Range("G17:G216")
    Range("G17:G216").Select
    Range("H16").Select
    ActiveCell.FormulaR1C1 = "=RC[1]*3.27"
    Range("H17").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-6]),"" "",R[-1]C)"
    Range("H17").Select
    Selection.AutoFill Destination:=Range("H17:H216")
    Range("H17:H216").Select
    Range("I16").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(R[1]C[-6]:R[200]C[-6])"
    Range("I17").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-7]),"" "",R[-1]C)"
    Range("I17").Select
    Selection.AutoFill Destination:=Range("I17:I216")
    Range("I17:I216").Select
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "X Avg ="
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "UCLnp ="
    Range("E5").Select
    ActiveCell.FormulaR1C1 = "LCLnp ="
    Range("E6").Select
    ActiveCell.FormulaR1C1 = "R Avg ="
    Range("E7").Select
    ActiveCell.FormulaR1C1 = "UCLmr ="
    Range("E8").Select
    ActiveCell.FormulaR1C1 = "Moving Range = | x2 - x1| = ABS(B17-B16))"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(R[13]C[-4]:R[148]C[-4])"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+(R[2]C*2.66)"
    Range("F5").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C-(R[1]C*2.66)"
    Range("F6").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(R[11]C[-3]:R[145]C[-3])"
    Range("F7").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C*3.27"
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "  average of all the x's =AVERAGE(B16:B216)"
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "  X Avg + (R Avg * 2.66)"
    Range("G5").Select
    ActiveCell.FormulaR1C1 = "  X Avg - (R Avg * 2.66)"
    Range("G6").Select
    ActiveCell.FormulaR1C1 = _
        "  average of the moving range (mR) values = AVERAGE(C17:C216)"
    Range("G7").Select
    ActiveCell.FormulaR1C1 = "  R Mean * 3.27"
    Range("E8").Select
    ActiveCell.FormulaR1C1 = "Moving Range = | x2 - x1| = ABS(B17-B16))"
    Call createchart
  
 End Sub



Sub createchart()
Sheets("MovingAverages").Select
Dim ch As Chart
 Range("A15:B200,E15:G200").Select


ActiveSheet.ChartObjects.Add Left:=5, Top:=4, Width:=500, Height:=200
Set ch = ActiveSheet.ChartObjects(1).Chart
With ch
    .ChartType = xlLineMarkers
    .SetSourceData Source:=ActiveSheet.Range("A15:A200,E15:G200"), PlotBy:=xlColumns

    With .Axes(xlValue)
    .HasMajorGridlines = True
    .HasMinorGridlines = False
   End With
End With


  

End Sub

Automating t-Test: Two-Sample Assuming Unequal Variances using VBA ,VBA Teacher Sourav,Kolkata 08910141720

Sub twosampletest()
'
' Macro1 Macro
'

'

 With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

Sheets("twosampletest").Select


Application.SendKeys "{ENTER}"
     Application.Run "ATPVBAEN.XLAM!Pttestv", ActiveSheet.Range("$A$1:$A$76"), _
        ActiveSheet.Range("$B$1:$B$76"), ActiveSheet.Range("$H$1:$W$25"), True, 0.05 _
        , 0
       
       
        ActiveSheet.Cells.Columns.AutoFit
   
      With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
  
End Sub

Automating Anderson Darling Test using VBA,VBA Teacher Sourav,Kolkata 08910141720

Sub anderson()
'
' Macro1 Macro
'

'

Sheets("anderson").Select

    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Enter the data into column E"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Average"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(R[-1]C[3]:R[198]C[3])"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "Sigma"
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "=STDEV(R[-2]C[3]:R[197]C[3])"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "n"
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R[-3]C[3]:R[196]C[3])"
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "S"
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-5]C[9]:R[194]C[9])"
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "AD"
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "=-R[-3]C-R[-1]C/R[-3]C"
    Range("A9").Select
    ActiveCell.FormulaR1C1 = "AD*"
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C*(1+0.75/R[-4]C+2.25/R[-4]C^2)"
    Range("A10").Select
    ActiveCell.FormulaR1C1 = "p Value"
    Range("B10").Select
    ActiveCell.FormulaR1C1 = "=MAX(R[5]C:R[8]C)"
    Range("A14").Select
    ActiveCell.FormulaR1C1 = "p Value  Calculations"
    Range("A15").Select
    ActiveCell.FormulaR1C1 = "p"
    Range("A16").Select
    ActiveCell.FormulaR1C1 = "p"
    Range("A17").Select
    ActiveCell.FormulaR1C1 = "p"
    Range("A18").Select
    ActiveCell.FormulaR1C1 = "p"
    Range("B15").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(R[-6]C<13>= 0.6),EXP(1.2937-5.709*R[-6]C+0.0186*R[-6]C^ 2),0)"
    Range("B16").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(R[-7]C<0 .6="">=0.34),EXP(0.9177-4.279*R[-7]C-1.38*R[-7]C^2),0)"
    Range("B17").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(R[-8]C<0 .34="">=0.2),1-EXP(-8.318+42.796*R[-8]C-59.938*R[-8]C^2),0)"
    Range("B18").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(R[-9]C<0 .2="" br="">    Range("B19").Select
 
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Value"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "i"
   'macro4
 
   Range("F1").Select
 
    ActiveCell.FormulaR1C1 = "i"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-1]),"""",1)"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-1]),"""",R[-1]C+1)"
    Range("F3").Select
    Selection.AutoFill Destination:=Range("F3:F153")
  
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Sorted"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-2]), NA(),SMALL(R2C[-2]:R201C[-2],RC[-1]))"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G151")
  
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "F(Xi)"
    With ActiveCell.Characters(Start:=1, Length:=3).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With ActiveCell.Characters(Start:=4, Length:=2).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = True
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("H2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-3]),"""",NORMDIST(RC[-1], R3C2, R4C2, TRUE))"
    Range("H2").Select
    Selection.AutoFill Destination:=Range("H2:H153")
  
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "1-F(Xi)"
    With ActiveCell.Characters(Start:=1, Length:=5).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With ActiveCell.Characters(Start:=6, Length:=2).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = True
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-4]), """", 1-RC[-1])"
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I153")
  
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "1-F(Xn-i+1)"
    With ActiveCell.Characters(Start:=1, Length:=5).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With ActiveCell.Characters(Start:=6, Length:=6).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = True
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("J2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-5]),"""",SMALL(R2C[-1]:R201C[-1],RC[-4]))"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J153")
    Range("J2:J153").Select
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "S"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-6]),"""",(2*RC[-5]-1)*(LN(RC[-3])+LN(RC[-1])))"
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K153")
    Range("K2:K153").Select
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "z"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-7]="""",NA(),NORMSINV((RC[-6]-0.3)/(R5C2+0.4)))"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L151")
    Range("L2:L151").Select
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=RC[1]*R4C2+R3C2"
    Range("M3").Select
    ActiveCell.FormulaR1C1 = "=RC[1]*R4C2+R3C2"
    Range("M4").Select
    ActiveCell.FormulaR1C1 = "=RC[1]*R4C2+R3C2"
    Range("M5").Select
 
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=RC[1]*R4C2+R3C2"
    Range("M3").Select
    ActiveCell.FormulaR1C1 = "=RC[1]*R4C2+R3C2"
    Range("M4").Select
    ActiveCell.FormulaR1C1 = "=RC[1]*R4C2+R3C2"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "-3"
    Range("N3").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("N4").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("N5").Select
  
    Dim ch As Shape
   Range("G2:G201,L2:L201").Select
    ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
     Set ch = ActiveSheet.Shapes(1)
    ch.Name = "Chartanderson"
  
  
    Application.CommandBars("Format Object").Visible = False
    ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
    ActiveChart.SetElement (msoElementPrimaryValueAxisTitleAdjacentToAxis)
    With ActiveChart
'chart name
.HasTitle = True
.ChartTitle.Characters.Text = "Normal Probability Test"
'X axis name
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "X"
'y-axis name
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Z"
End With

Range("A1").Select

End Sub